view cpack/dml/lib/bl_p2r.pl @ 0:718306e29690 tip

commiting public release

/* 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(bl_p2r,[ audio_file/3, audio_link/2, scrape_audio_link/2, has_available_audio/1 ]).

:- use_module(library(semweb/rdf_db)).
:- use_module(library(xmlarchive)).
:- use_module(library(xpath)).
:- use_module(library(settings)).
:- use_module(library(sandbox)).
:- use_module(library(fileutils)).
:- use_module(library(termutils)).
:- use_module(library(rdfutils)).
:- use_module(library(insist)).
:- use_module(library(memo)).
:- use_module(entailment(p2r)).
:- use_module(cliopatria(hooks)).
:- use_module(library(http/http_client)).

:- set_prolog_flag(double_quotes,string).

/*
   METS to RDF conversion.

   Useful info:
   0. Each top-level mets:mets element contains several sections.
      1,4 x dmdSec     .. 1 x mdWrap
      1   x amdSec     .. [ N x techMD, {0,1} x rightsMD, {0,1} x sourceMD ]
      1   x fileSec    .. 1-4 x fileGrp .. 1-36 x file
      1   x structLink .. {1,3} x smLink
      2-3 x structMap  .. 1 x div

   1. Each dmdSec only ever contains one mdWrap element
   5. each techMD or sourceMD contains exactly 1 mdWrap
   6. each rightsMD contains an mdRef
   7. The rightsMD is not interesting to look at.
   8. dmdSec mdWraps can be empty

   List of all dmdSec tags in dataset
      blapsi:id3album
      blapsi:id3artist
      blapsi:id3comment
      blapsi:id3songtitle
      blapsi:id3year
      dc:description
      dc:identifier
      dc:language
      dc:rights
      dc:source
      dc:subject
      dc:title
      dc:type
      dcterms:created
      dcterms:isPartOf
      dcterms:spatial
      dcterms:temporal
      marcrel:CMP
      marcrel:CND
      marcrel:IVE
      marcrel:IVR
      marcrel:LYR
      marcrel:PRF
      marcrel:RCE
      marcrel:SPK
      mods:accessCondition
      mods:identifier
      mods:name
      mods:recordInfo
      mods:titleInfo

   amdSec tags
      blapsi:audioObject
      blapsi:file_bitrate
      blapsi:file_channels
      blapsi:file_duration
      blapsi:file_sample
      blapsi:resolution

   sourceMD .. blapsi:audioObject
      blapsi:face 
      blapsi:format 
      blapsi:physicalProperties 
         blapsi:face 
         blapsi:format 
         blapsi:physicalProperties 
         blapsi:primaryIdentifier 
         blapsi:secondaryIdentifier
      blapsi:primaryIdentifier 
      blapsi:secondaryIdentifier

   would prefer to have mo predicates to foaf:Person resources for these.
      marcrel:'CMP',dml:composer).
      marcrel:'CND',dml:conductor).
      marcrel:'PRF',dml:performer).

 */

:- setting(audio_root,ground,nothing,'Root directory of audio file collection').
:- setting(archive_pattern,atom,'~/lib/datasets/mets/BL_metadata_complete.7z','Pattern to match METS metadata files').

:- rdf_register_prefix(bldata,'http://sounds.bl.uk/resource/').
:- rdf_register_prefix(marcrel,'http://id.loc.gov/vocabulary/relators/').
:- rdf_register_prefix(blapsi,'http://sounds.bl.uk/blapsi#').
:- rdf_register_prefix(blterms,'http://www.bl.uk/schemas/bibliographic/blterms#').

% https://code.google.com/p/libarchive/issues/detail?id=328&colspec=ID%20Type%20Status%20Priority%20Milestone%20OpSys%20Owner%20Summary

:- public import/0.
import :- assert_all(bl_p2r).

rdf(dml:blpage,rdfs:range,foaf:'Document') <== true.
rdf(dml:blpage,rdfs:subPropertyOf,foaf:page) <== true.
rdf(S,P,O) <== bl_archive_triple(T), once(expand_triple(T,rdf(S,P,O))).

expand_triple(rdf(SS,PP,OO),rdf(S,P,O)) :-
   uripattern:pattern_uri(SS,S),
   uripattern:pattern_uri(PP,P),
   (  OO=literal(_) -> rdf_global_object(OO,O)
   ;  uripattern:pattern_uri(OO,O)
   ).

%% import_directory(+Dir:atom, +Graph:atom) is det.
%
%  Import contents of a given directory into a named RDF graph. 
%  The directory must be a subdirectory of the directory named in the 
%  bl_p2r:audio_root setting (whose value is either =|just(Dir)|= or 
%  =|nothing|=).
import_directory(Dir,Graph) :-
   forall( directory_triple(Dir,T), (once(expand_triple(T,rdf(S,P,O))), rdf_assert(S,P,O,Graph))).

directory_triple(Dir,T) :-
   Ext=txt,
   setting(audio_root,just(AudioRoot)),
   atom_concat(AudioRoot,'/',Prefix),
   find_files(under(AudioRoot/Dir),FullPath),
   atom_concat(Prefix,Path,FullPath),
   split_path(Path,Loc,Ext),
   with_stream(Str,open(FullPath,read,Str), ext_loc_stream_triple(Ext,Loc,Str,T)).


%% bl_archive_triple(-T:rdf) is nondet.
%  This predicate generates triples from the metadata archive files whose names
%  match the pattern stored in the setting bl_p2r:archive_pattern.
bl_archive_triple(T) :-
   setting(archive_pattern, ArchivePattern),
   find_files(like(ArchivePattern), Archive),
   with_archive_stream(Archive, Path, path_triple_stream(Path,T)).

path_triple_stream(Path,T,S) :- 
  status('Importing ~s',[Path]),
  catch(( insist(split_path(Path,Loc,Ext)),
           ext_loc_stream_triple(Ext,Loc,S,T)
        ), Ex, (nl,print_message(warning,Ex),fail)).

split_path(Path,Dirs-Base,Ext) :-
   % split_string(Path,'/','',Parts),
   atomic_list_concat(Parts,'/',Path),
   exclude(ignore_dir,Parts,Parts1),
   append(Dirs,[Name],Parts1),
   sub_atom(Name,_,3,0,Ext), % NB this assumes three character extension
   sub_atom(Name,0,_,4,Base). 

%% ext_loc_stream_triple(+Ext:atom, +Loc:pair(list(atom), atom), +S:stream, -T:rdf) is nondet.
%
%  This predicate succeeds once for each RDF triple that can be derived from
%  an archive stream whose path in the archive Loc=Dirs-Base consist of the directories
%  Dirs and whose name is Base,'.',Ext. It understands entries with extensions
%  xml and txt. XML streams are decoded as full METS documents. TXT streams are decoded
%  as the DMD section of a METS document. Other extensions generate a warning and then fail.

ext_loc_stream_triple(xml,Dirs-Base,S,T) :- !,
   insist(load_xmlns(S,Doc)), 
   insist(member(element(mets:mets,_,METS),Doc)),
   (  insist(get_bl_url(Base,Dirs,URL)),
      T=rdf(bldata:Base,dml:blpage,URL)
   ;  T=rdf(bldata:Base,rdf:type,mo:'Signal')
   ;  insist(multi,member(element(Tag,_,Content),METS),no_content(mets,Dirs-Base)),
      mets_triple(Tag,Content,Dirs,Base,T)
   ).

ext_loc_stream_triple(txt,Dirs-Base,S,T) :- !,
   % TXT streams appear to be LATIN-1 encoded, not UTF-8
   Base\=combined, % exclude combined metadata files
   set_stream(S,encoding(iso_latin_1)), 
   insist(load_xmlns(S,Doc)),
   txt_triple(Doc,Dirs,Base,T).

ext_loc_stream_triple(Ext,Dirs-Base,_,_) :-
   warning(unrecognised_extension(Ext,Dirs-Base)). 


%% get_bl_url(+Name:atom,+Dirs:list(atom),-URL:atom) is det.
%  Deduces the sounds.bl.uk URL from entry name and directory.
get_bl_url(Name,Dirs,URL) :-
   sub_atom(Name,0,4,_,CatCode),
   category(CatCode,Category),
   append(_,[Collection],Dirs),
   atomic_list_concat([ 'http://sounds.bl.uk',
                        Category,Collection,Name],'/',URL).

category('021M','Oral-history').
category('025M','World-and-traditional-music').
category('023M','Jazz-and-popular-music').
category('026M','Classical-music').
category('028M','Jazz-and-popular-music').
category('020A','Classical-music').

ignore_dir('_Metadata').
ignore_dir('_Non-music').
ignore_dir('_Audio_Metadata').

% --------------------- TOP LEVEL STRUCTURE -------------------------------

unwrap([element(mets:mdWrap,MDAttr,[element(mets:xmlData,_,XMLContent)])],MDAttr,XMLContent).

% for complete METS documents
mets_triple(mets:dmdSec,DMDContent,_,ID,T) :- !, 
   unwrap(DMDContent,MDAttr,XMLContent),
   member('MDTYPE'='DC',MDAttr),
   dmd_triple(XMLContent,bldata:ID,T).

mets_triple(mets:amdSec,AMDContent,_,ID,T) :- !,
   member(element(Tag,Attr,Content),AMDContent),
   amd_triple(Tag,Attr,Content,ID,T).

mets_triple(mets:fileSec,FileSecContent,Dirs,ID,T) :- !,
   member(element(T1,GAttr,GroupContent),FileSecContent), insist(T1=mets:fileGrp),
   member(element(T2,FAttr,FileContent),GroupContent), insist(T2=mets:file),
   \+member('ID'='WEBRESOURCES',GAttr),
   FileContent=[element(Tag,Attr,Content)],
   file_triple(Tag,Attr,Content,GAttr-FAttr,Dirs,ID,T).

mets_triple(mets:metsHdr,_,_,_,_) :- !, fail.
mets_triple(mets:structLink,_,_,_,_) :- !, fail.
mets_triple(mets:structMap,_,_,_,_) :- !, fail.
mets_triple(Tag,_,_,_,_) :- warning(unrecognised_tag(Tag,mets:mets)).

% for txt, partial XML documents
txt_triple(_,_,ID,rdf(bldata:ID,rdf:type,mo:'Signal')).
txt_triple(Doc,Dirs,ID,T) :- 
   insist(multi,member(element(Tag,_,Content),Doc),no_content(txt)),
   txt_tag_triple(Tag,Content,Dirs,ID,T).

identifier_file_ext(F,F1,mp3) :- sub_atom(F,Bef,_,_,'.mp3'), !, insist(sub_atom(F,0,Bef,_,F1)).
identifier_file_ext(F,F1,wav) :- sub_atom(F,Bef,_,0,'.wav'), !, insist(sub_atom(F,0,Bef,_,F1)).
identifier_file_ext(F,F1,m4a) :- sub_atom(F,Bef,_,0,'.m4a'), !, insist(sub_atom(F,0,Bef,_,F1)).

txt_tag_triple(dc:identifier, [F], Dirs, ID, rdf(bldata:ID, bldata:path, literal(Path))) :- !,
   % NB some of the txt files have the file name written twice. Hence I am going to discard
   % everything after the first dot. Relies on sub_atom returning matches starting from the beginning
   (  identifier_file_ext(F,F1,Ext)
   -> file_name_extension(F1,Ext,Name),
      atomics_to_string(Dirs,"/",Dir),
      directory_file_path(Dir,Name,Path)
   ;  print_message(warning,txt_triple_identifier_fail(ID,F)),
      fail
   ).

% !!! MUSICALS only. Should not really have mo:duration in them either...
txt_tag_triple(dml:rating,Content, _, ID, rdf(bldata:ID, dml:rating, literal(Content))) :- !.
txt_tag_triple(mo:duration,Content, _, ID, rdf(bldata:ID, mo:duration, literal(type(xsd:float,Millis)))) :- !,
   insist(Content=[Dur],bad_content(Content,mo:duration)),
   insist(atom_number(Dur,Millis)).
txt_tag_triple(blapsi:file_duration,Content, _, ID, rdf(bldata:ID, mo:duration, literal(type(xsd:float,Millis)))) :- !,
   insist(Content=[Dur],bad_content(Content,blapsi:file_duration)),
   % insist(parse_duration_millis(Dur,Millis)).
   (  parse_duration_millis(Dur,Millis) -> true
   ;  warning(bad_duration(ID,Dur))
   ).
txt_tag_triple(Tag,Content,_,ID,T) :- dmd_tag_triple(Tag,Content,bldata:ID,T).


% --------------- Document meta data --------------------------

dmd_triple(DMD,URI,T) :-
   member(element(Tag,_,Content),DMD),
   dmd_tag_triple(Tag,Content,URI,T).

dmd_tag_triple(dcterms:contributor,Content,ID,T) :- !, dmd_triple(Content,bldata:ID,T).
dmd_tag_triple(dc:contributor,Content,ID,T) :- !, dmd_triple(Content,bldata:ID,T).
dmd_tag_triple(marcrel:REL,Content,URI,rdf(URI,marcrel:Rel,literal(Lit))) :- !, 
   Content=[Lit],%empty_tag(marcrel:REL,Content)),
   downcase_atom(REL,Rel).
dmd_tag_triple(Tag,Content,URI,rdf(URI,Tag,literal(Lit))) :- keep_tag(Tag), !, Content=[Lit].
dmd_tag_triple(Tag,_,_,_) :- ignore_tag(Tag), !, fail.
dmd_tag_triple(Tag,_Content,URI,_) :- warning(unrecognised_tag(Tag,dmd,URI)).

% !!!FIXME - sometimes dates are given in D/M/Y instead of Y-M-D
keep_tag(dc:title).
keep_tag(dc:description).
keep_tag(dc:source).
keep_tag(dc:subject).
keep_tag(dc:language).
keep_tag(dc:created).
keep_tag(dcterms:language).
keep_tag(dcterms:abstract).
keep_tag(dcterms:created).
keep_tag(dcterms:spatial).
keep_tag(dcterms:temporal).
keep_tag(dcterms:extent). % !!!FIXME need to parse this
keep_tag(blterms:mechanism).
keep_tag(dcterms:isPartOf).
keep_tag(blapsi:format).

ignore_tag(dc:identifier).
ignore_tag(blapsi:marker).
ignore_tag(dc:rights).
ignore_tag(dc:type).
ignore_tag(rdf:about).
ignore_tag('ARK').

% ------------------------- ADMINISTRATIVE METADATA SECTION -----------------------------

amd_triple(mets:sourceMD,_,SMDContent,ID,T) :-
   insist(unwrap(SMDContent,_,XMLContent),no_xml_content(SMDContent,smd)),
   atom_concat(ID,'#source',Src),
   (  T=rdf(bldata:ID,dml:source,bldata:Src)
   ;  insist(multi,member(element(Tag,Attr,Content),XMLContent),no_xml_content(smd)),
      smd_xml_triple(Tag,Attr,Content,bldata:Src,T)
   ).

amd_triple(mets:techMD,Attr,TMDContent,ID,T) :-
   insist(member('ID'=TMDId,Attr)),
   unwrap(TMDContent,_,XMLContent),
   (  T=rdf(bldata:ID/TMDId, mo:sampled_version_of, bldata:ID)
%  ;  T=rdf(bldata:ID/TMDId, dml:annotation,literal(Label)), member('LABEL'=Label,TMDAttr)
   ;  member(element(Tag,_,Content),XMLContent),
      blapsi_triple(Tag, Content, bldata:ID/TMDId, T)
   ).

blapsi_triple(blapsi:Tag, [Text], Signal, rdf(Signal, Pred, literal(Lit))) :-
   insist(blapsi_info(Tag, Text, Pred, Lit)).

% ------------ Source ---------------

smd_xml_triple(blapsi:audioObject,Attr,AOContent,SrcURI,rdf(SrcURI,Pred,literal(Lit))) :- !,
   (  member(A=Lit,Attr), A\='ID', Pred=bldata:A
   ;  insist(multi,member(element(Tag,Attr1,Content),AOContent),no_content(blapsi:audioObject,AOContent)),
      ao_tag_info(Tag,Attr1,Content,Pred,Lit)
   ).

smd_xml_triple(blapsi:Tag,Content,SrcURI,rdf(SrcURI,blapsi:Tag,literal(Lit))) :- !,
   insist(Content=[Lit],bad_content(blapsi:Tag,Content,smd_xml_triple)).

ao_tag_info(blapsi:primaryIdentifier,_,_,_,_) :- !, fail.
ao_tag_info(blapsi:secondaryIdentifier,_,_,_,_) :- !, fail.
ao_tag_info(blapsi:format,_,Content,blapsi:format,Lit) :- !, 
   insist(Content=[Lit],bad_content(Content,blapsi:format)).
ao_tag_info(blapsi:face, Attr, Content, Pred, Lit) :- !,
   %insist(member('ID'=ID,Attr)),
   insist(member('label'=Label,Attr)),
   insist(Content=[],non_empty_content(blapsi:face,Content)),
   (  fail % Pred=bldata:face_id, Lit=ID    IGNORE FOR NOW
   ;  Pred=bldata:face_label, Lit=Label
   ).
ao_tag_info(blapsi:physicalProperties, _, PPContent, Tag, Lit) :- !,
   insist(multi,member(element(Tag,_,Content),PPContent),no_content(blapsi:physicalProperties)),
   insist(Content=[Lit],bad_content(Tag,Content)).
ao_tag_info(Tag,_,_,_,_) :- 
   warning(unrecognised_tag(Tag,blapsi:audioObject)).

% identifier_pred('ASR Root ID',asr_root_id).
% identifier_pred('Sound Archive accession number',accession_number).



% -------------- FILE SECTION ---------------------------

file_triple(mets:'FLocat',Attr,LocContent,GAttr-FAttr,Dirs,ID,T) :- !,
   (  member('MIMETYPE'=MimeType,FAttr)
   -> audio_mimetype(MimeType),
      insist(member('AMDID'=TMDId1,FAttr)), 
      insist(member('LOCTYPE'='URL',Attr)),
      insist(member((xlink:href)=Link,Attr)),
      insist(LocContent=[],non_empty(mets:'FLocat',LocContent)),
      insist(member('USE'=Use1,FAttr);member('USE'=Use1,GAttr)),
      % TMDId1 is sometimes "techMDxx digiprovXX" - need to get rid of second word
      atomic_list_concat([TMDId|_],' ',TMDId1),
      downcase_atom(Use1,Use),
      (  T=rdf(bldata:ID/TMDId,dml:mimetype,literal(MimeType))
      ;  file_path_triple(bldata:ID/TMDId,Dirs,Link,T)
      ;  T=rdf(bldata:ID/TMDId,bldata:use,literal(Use))
      )
   ;  insist(\+member('AMDID'=_,FAttr)),
      insist(member('ID'=FileID,FAttr)),
      insist(member('LOCTYPE'='URL',Attr)),
      insist(member((xlink:href)=Link,Attr)),
      sub_atom(Link,_,3,0,Ext),
      audio_extension(Ext),
      (  T=rdf(bldata:ID/FileID,mo:sampled_version_of,bldata:ID)
      ;  file_path_triple(bldata:ID/FileID,Dirs,Link,T)
      ;  member(element(Tag,_,Content),LocContent),
         blapsi_triple(Tag,Content,bldata:ID/FileID,T)
      )
   ).

file_triple(mets:'Fcontent',_,_,_,_,_,_) :- !, fail.
file_triple(Tag,_,_,_,_,_,_) :- warning(unrecognised_tag(Tag,file)).

file_path_triple(URI,Dirs,Link,rdf(URI,bldata:path,literal(Path))) :-
   atomics_to_string(Parts,"/",Link),
   atomics_to_string(Dirs,"/",Dir),
   append(_,[Name],Parts),
   directory_file_path(Dir,Name,Path).

audio_mimetype('sound/wav').
audio_mimetype('sound/wma').
audio_mimetype('sound/mp3').
audio_mimetype('sound/ogg').

audio_extension(wav).
audio_extension(mp3).
audio_extension(wma).

% ---------------------------- BLAPSI INFO ---------------------------------

blapsi_info(file_sample,     X, mo:sample_rate,   type(xsd:float,SampleRate)) :- atom_number(X,SampleRate).
blapsi_info(file_resolution, X, mo:bitsPerSample, type(xsd:int,Bits)) :- atom_number(X,Bits).
blapsi_info(resolution,      X, mo:bitsPerSample, type(xsd:int,Bits)) :- atom_number(X,Bits).
blapsi_info(file_channels,   X, mo:channels,      type(xsd:int,Channels)) :- atom_number(X,Channels).
blapsi_info(file_duration,   X, mo:duration,      type(xsd:float,Millis)) :- parse_duration_millis(X,Millis).
blapsi_info(file_bitrate,    X, blapsi:file_bitrate, X). % !!! FIXME should be attached to file, not to signal
blapsi_info(file_size,       X, blapsi:file_size, type(xsd:int,Size)) :- atom_number(X,Size).
blapsi_info(file_length,     X, blapsi:file_length, type(xsd:int,Size)) :- atom_number(X,Size).

% --------------------------- SUPPORTING PREDICATES --------------------------

:- use_module(library(async)).
:- public scrape_all/2.
:- volatile_memo scrape_all(+options:list,-count:nonneg).
scrape_all(Opts,Count) :-
   option(spacing(Sleep),Opts,1),
   option(timeout(Timeout),Opts,10),
   findall( R, rdf(R,dml:blpage,_), Rs),
   with_progress_stack(map_with_progress(scrape_then_sleep(Sleep,Timeout),Rs,Ss)),
   exclude(=(ok),Ss, Failures),
   (Failures=[] -> length(Rs,Count); throw(scrape_errors(Failures))).

scrape_then_sleep(D,T,R,Status) :- 
   (  audio_link(R,_) -> Status=ok
   ;  memo:reify(bl_p2r:slow(D,call_with_time_limit(T,scrape_audio_link(R,_))),Status),
      (Status=ex(abort(Reason)) -> throw(abort(Reason)); true)
   ).

slow(Delay,Goal) :- call(Goal), sleep(Delay).

%% has_available_audio(+R:uri) is semidet.
%% has_available_audio(-R:uri) is nondet.
%  True when R is a recording in the BL collection whose audio is 
%  publicly available.
has_available_audio(R) :-
   rdf(R,dml:blpage,_),
   scrape_audio_link(R,_).

:- public audio_link/2.
audio_link(URI,AudioURL) :- 
   browse(scrape_audio_link(URI,AudioURL)).

:- public audio_file/3.
audio_file(URI,Path,just(mp3)) :-
   setting(audio_root,just(Root)),
   (  rdf(URI,bldata:path,literal(RelPath)),
      rdf(URI,rdf:type,mo:'Signal')
   ;  rdf(URI2,mo:sampled_version_of,URI),
      rdf(URI2,dml:mimetype,literal('sound/mp3')),
      rdf(URI2,bldata:path,literal(RelPath))
   ),
   atomic_list_concat([Root,RelPath],'/',Path).

:- volatile_memo scrape_audio_link(+atom,-atom).

scrape_audio_link(URI,AudioURL) :-
   rdf(URI,dml:blpage,PageURL),
   debug(bl_p2r,'Scraping audio link for ~w...',[URI]),
   atom_concat('http://sounds.bl.uk/',_,PageURL),
   http_get(PageURL,Doc,[]),
   xpath(Doc,//li(@class=mainTrack)/a(@id),ID),
   string_concat("MNT-",Key,ID),
   string_concat('http://sounds.bl.uk/GT/',Key,AudioURL).

sandbox:safe_primitive(bl_p2r:audio_link(_,_)).
sandbox:safe_primitive(bl_p2r:scrape_audio_link(_,_)).
 
xpath(Prop,E,Path,Val) :- xpath(E,Path,I), xpath(I,/self(Prop),Val).

warning(Term) :- nl, print_message(warning,Term), fail.