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]).