Mercurial > hg > dml-open-cliopatria
view cpack/dml/api/archive.pl @ 0:718306e29690 tip
commiting public release
author | Daniel Wolff |
---|---|
date | Tue, 09 Feb 2016 21:05:06 +0100 |
parents | |
children |
line wrap: on
line source
/* Part of DML (Digital Music Laboratory) Copyright 2014-2015 Samer Abdallah, University of London This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ :- module(api_archive, [ locator_uri/2, with_input_from_uri/2, uri_absolute_path/2, archive_file/3, archive_file/2 ]). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_parameters)). :- use_module(library(xmlarchive)). :- use_module(library(httpfiles)). :- use_module(library(fileutils)). :- use_module(library(insist)). :- set_prolog_flag(double_quotes,string). :- rdf_register_prefix(file,'file://'). :- http_handler(api(archive/get), archive_get, []). :- setting(archive:root,string,"~/lib/dml-archive","Directory containing accessible files"). user:file_search_path(archive,Path) :- setting(archive:root,DD), expand_file_name(DD,[Path]). archive_get(Request) :- http_parameters(Request, [uri(URI, [optional(false), description("URI of archive entry")])]), file_name_extension(_,Ext,URI), with_input_from_uri(URI,reply_from_stream(Ext)). uri_absolute_path(URI,Path) :- var(Path), !, insist(string_concat("file://",LocString,URI)), absolute_file_name(archive(LocString),Path,[access(read)]). uri_absolute_path(URI,Path) :- file_search_path(archive,Root), atom_concat(Root,Rel,Path), atom_concat('file:/',Rel,URI). :- meta_predicate with_input_from_uri(+,1). with_input_from_uri(URI,Goal) :- insist(string_concat("file://",LocString,URI)), ( sub_string(LocString,PathLen,1,FragLen,"#") -> sub_string(LocString,0,PathLen,_,Path), sub_atom(LocString,_,FragLen,0,Frag), absolute_file_name(archive(Path),ArchivePath,[access(read)]), with_archive_stream(ArchivePath,Frag,Goal) ; absolute_file_name(archive(LocString),AbsPath,[access(read)]), with_stream(S, open(AbsPath,read,S), call(Goal,S)) ). reply_from_stream(Ext,Stream) :- reply_stream(Stream,Ext). locator_uri(file(Parts), URI) :- atomic_list_concat(['file:/'|Parts],'/',URI). locator_uri(archive_entry(ArchivePath,EntryName), URI) :- atomic_list_concat(['file://',ArchivePath,'#',EntryName],URI). %% archive_file(+Ext:atom, +In:path, -Out:uri) is det. %% archive_file(+In:path,-Out:uri) is det. % % This procedure finds a permanent home for the file In, moving it into % the directory tree managed by the archive, giving it a unique file name, % and returning the URI of the location. % % !! could add extension if necessary archive_file(In,Out) :- archive_file('',In,Out). archive_file(Ext,In,Out) :- get_time(Time), format_time(atom(Dir),'auto/%Y%m%d',Time), expand_file_search_path(archive(Dir),FullDir), ( exists_directory(FullDir) -> true ; make_directory(FullDir) ), once( ( repeat, random_name(Ext,8,Str), directory_file_path(FullDir,Str,Path), \+exists_file(Path) )), rename_file(In,Path), uri_absolute_path(Out,Path). random_name(Ext,Len,String) :- length(Chars,Len), maplist(web_storage:random_char,Chars), format(string(String),'~s~s',[Chars,Ext]).