diff cpack/dml/api/archive.pl @ 0:718306e29690 tip

commiting public release

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpack/dml/api/archive.pl	Tue Feb 09 21:05:06 2016 +0100
@@ -0,0 +1,93 @@
+/* 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]).
+
+