Mercurial > hg > dml-open-cliopatria
diff cpack/dml/lib/charm_p2r.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 diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cpack/dml/lib/charm_p2r.pl Tue Feb 09 21:05:06 2016 +0100 @@ -0,0 +1,245 @@ +/* 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(charm_p2r, [ audio_link/3 ]). + +/** <module> Access to beets database + */ + + +% :- use_module(library(odbc)). +:- use_module(library(csv)). +:- use_module(library(musicbrainz)). +:- use_module(library(semweb/rdf_db)). +:- use_module(library(termutils)). +:- use_module(library(rdfutils)). +:- use_module(library(stringutils)). +:- use_module(library(dcg/basics)). +% :- use_module(library(odbcutils)). +:- use_module(entailment(p2r)). +:- use_module(library(memo)). +% :- use_module(library(resolve)). + +:- set_prolog_flag(double_quotes,string). + +:- rdf_register_prefix(charm,'http://dml.org/charm/'). + +:- setting(csv_database,string,"~/lib/charm/charm-1.csv","Location of CHARM colon-separated-values"). +:- setting(audio_root,ground,nothing,"Location of CHARM audio files"). +% item(Id) :- +% odbc_query(charm,"select id from cmr",row(Id)). + +% item(Id,Prop,Val) :- +% odbc_table_column(charm,cmr,Prop), +% \+ignore_column(Prop), +% qsql(charm,"select ~w from cmr where id=~d and ~w is not null and ~w!=''",[Prop,Id,Prop,Prop], row(Val)). + +% ignore_column(id). +% ignore_column(digital_eq). +% ignore_column(eq_base). +% ignore_column(eq_mid). +% ignore_column(eq_top). +% ignore_column(old_id). + +map('TNo',tno). %? + +% work +map('Title',title,list(";",atom)). +map('Composer(s)',composer,list("/",composer)). + +% performance +map('Artist',performer,list("/",set(";",performer))). +map('Conductor',conductor,atom). + +map('Label',label,atom). +map('Series',series,atom). +map('Cat No.',cat_no,atom). +map('Size',size,number). +% map('Matrix No.',matrix_no,atom). +% map('Single Side No. (or other ref.)',single_side_no). +map('File Name',file_name,atom). +map('Notes',notes,atom). +map('Rec.Date (dd/mm/yyyy)', recording_date, date(old)). + +% transfer event (recording from vinyl to digital signal) +map('Speed', speed, number). + +% No need for this much detail really.. +% map('Stylus',stylus_size, number). +% map('Weight',stylus_weight, number). +% map('EQ bass',eq_bass). +% map('EQ mid',eq_mid). +% map('EQ top',eq_top). +% map('Digital EQ','digital_eq'). +% map('turnover',turnover). +map('tech notes', technical_notes, atom). +map('x-fer date', transfer_date, date(new)). +map('Transfer Engineer', transfer_engineer, atom). + +:- volatile_memo string_to_date(+atom,+string,-ground). +string_to_date(Era,X,Date) :- + string_codes(X,Codes), + once(phrase(charm_interval(Era,DD),Codes)), + charm_date_to_time(DD,Date). + +:- rdf_meta convert(+,+,o). +convert(string,X,literal(X)). +convert(atom,X,literal(Y)) :- atom_string(Y,X). +convert(number,X,literal(Y)) :- number_string(Y,X). +convert(date(E),X,literal(Date)) :- string_to_date(E,X,Date). +convert(set(Sep,Type),X,Y) :- + split_string(X,Sep,"\s",Xs), + member(Z,Xs), + convert(Type,Z,Y). +convert(list(Sep,Type),X,Y) :- + split_string(X,Sep,"\s",Xs), + member(Z,Xs), + convert(Type,Z,Y). + +convert(performer,X,Y) :- convert(atom,X,Y). +% convert(performer,X,literal(Y)) :- +% porter_stem:tokenize_atom(X,Tokens), +% phrase(charm_performer(Perf),Tokens), +% phrase(performer(Perf),Codes1), +% atom_codes(Y,Codes1). + + +convert(arranger,X,literal(Y)) :- atom_concat(X,' [arranger]',Y). +convert(writer,X,literal(Y)) :- atom_concat(X,' [writer]',Y). + +convert(composer,X,Y) :- + split_string_around(" arr. ",X,Composer,Arranger), !, + ( convert(composer,Composer,Y) + ; convert(arranger,Arranger,Y) + ). + +convert(composer,X,Y) :- + split_string_around(" - ",X,Composer,Writer), !, + ( convert(composer,Composer,Y) + ; convert(writer,Writer,Y) + ). + +convert(composer,X,literal(Y)) :- traditional(X,Z), !, format(atom(Y),'[traditional:~s]',[Z]). +convert(composer,X,literal(Y)) :- anonymous(X,Z), !, format(atom(Y),'[anonymous:~s]',[Z]). +convert(composer,X,literal(Y)) :- atom_string(Y,X). + +% charm_performer(agent(Tokens)) --> + +anonymous(X,Z) :- (string_concat("Anon",Y,X); string_concat("anon",Y,X)), strip_string(Y,Z). +traditional(X,Z) :- string_concat("Trad.",Y,X), strip_string(Y,Z). + + +pad_int(L,N,C1,C2) :- format(codes(C1,C2),'~`0t~d~*+',[N,L]). + +xsd_time(ymd(Y,M,D),xsd:date) --> pad_int(4,Y), "-", pad_int(2,M), "-", pad_int(2,D). +xsd_time(ym(Y,M),xsd:gYearMonth) --> pad_int(4,Y), "-", pad_int(2,M). +xsd_time(y(Y),xsd:gYear) --> pad_int(4,Y). +xsd_time(range(D1,_),Type) --> xsd_time(D1,Type). + +charm_date_to_time(Date,type(Type,Value)) :- + phrase(xsd_time(Date,Type1),Codes), + rdf_global_id(Type1,Type), + atom_codes(Value,Codes). + +year(old,Y) --> integer(YY), { YY>=100 -> Y=YY ; Y is YY+1900 }. +year(new,Y) --> integer(YY), { YY>=100 -> Y=YY ; Y is YY+2000 }. +month(M) --> integer(M), {between(1,12,M)}. +day(D) --> integer(D), {between(1,31,D)}. + +charm_date(E,ymd(Y,M,D)) --> year(E,Y), "-", month(M), "-", day(D). +charm_date(E,ymd(Y,M,D)) --> day(D), "-", month(M), "-", year(E,Y). +charm_date(E,ymd(Y,M,D)) --> day(D), "/", month(M), "/", year(E,Y). +charm_date(E,ymd(Y,M,D)) --> day(D), ".", month(M), ".", year(E,Y). +charm_date(E,ym(Y,M)) --> year(E,Y), "-", month(M). +charm_date(E,ym(Y,M)) --> month(M), "/", year(E,Y). +charm_date(E,y(Y)) --> year(E,Y). + +charm_interval(_,range(y(Y1),y(Y2))) --> + integer(Y1), {Y1>=100}, "-", + integer(YY), {YY>12}, + { YY<100 -> Y2=1900+YY; Y2=YY }. + +charm_interval(E,Int) --> + charm_date(E,D1), + ( "--", charm_date(E,D2), {Int=range(D1,D2)} + ; {Int=D1} + ). + + +rdf(charm:title, rdfs:subPropertyOf, dc:title) <== true. +rdf(charm:enc(Id), charm:enc(Prop), Obj) <== + setting(csv_database,Pattern), + expand_file_name(Pattern,[DBFile]), + csv_to_rdf(DBFile,Id,Prop,Obj). + +csv_to_rdf(DBFile,Id,Prop,Obj) :- + once(csv_read_file_row(DBFile,Header,[convert(false),line(1)])), + functor(Header,row,NumCols), + functor(Row,row,NumCols), + arg(N,Header,' I.D.'), + arg(N,Row,Id), + csv_read_file_row(DBFile,Row,[convert(false),line(L)]), L>1, + status("Importing charm: ~w",[Id]), + map_row(Header,Row,Prop,Obj). + +null_value(""). +null_value("na"). +null_value("n/a"). +null_value("#VALUE!"). + +map_row(Header,Row,Pred,Obj) :- + arg(I,Header,Col), arg(I,Row,Val1), + map(Col,Pred,Type), + strip_string(Val1,Val), \+null_value(Val), + ( convert(Type,Val,Obj) *-> true + ; print_message(warning,conversion_failed(Col,Type,Val)), + format(atom(Lit),'FAILED(~q)',[Val]), % fail + Obj=literal(Lit) + ). + +% Old MYSQL version +% rdf(charm:num(4,Id), charm:enc(Prop), literal(Val)) <== +% item(Id), +% status("Importing charm:~d",[Id]), +% item(Id,Prop,Val). + + +:- public import/0. +% import :- with_odbc(charm, assert_all(charm_p2r)). +import :- assert_all(charm_p2r). + +:- public audio_file/3. +audio_file(URI,Path,just(flac)) :- + rdf(URI,charm:file_name,literal(FileName)), + setting(audio_root,just(Root)), + atomic_list_concat([Root,'/',FileName,'.',flac],Path). + +audio_link(Type,URI,URL) :- + member(Type,[mp3,flac]), + rdf(URI,charm:file_name,literal(Filename)), + ( sub_atom(Filename,_,_,_,'£') + -> atom_codes(Filename,C1), + fix_url(C1,C2), + atom_codes(Filename2,C2) + ; Filename2=Filename + ), + format(atom(URL),'http://charm.cchcdn.net/audio/~w/~w.~w',[Type,Filename2,Type]). + +fix_url([],[]). +fix_url([0'£|C1],[0'%, 0'A, 0'3|C2]) :- !, fix_url(C1,C2). +fix_url([C|C1],[C|C2]) :- !, fix_url(C1,C2).