1/* bibtex_rdf 2 Author: Giménez, Christian. 3 4 Copyright (C) 2017 Giménez, Christian 5 6 This program is free software: you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation, either version 3 of the License, or 9 at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program. If not, see <http://www.gnu.org/licenses/>. 18 19 15 jun 2017 20*/ 21 22 23:- module(bibtex_rdf, [ 24 guess_sufix/3, 25 guess_subject/2, 26 bibtex_to_rdf/2, 27 bibtexfile_to_rdf/2 28 ]).
37:- license(gplv3). 38 39:- ensure_loaded(library(semweb/rdf_db)). 40:- ensure_loaded(library(dcg/basics)). 41:- ensure_loaded(library(bibtex)). 42 43:- dynamic paper_prefix/1, author_prefix/1.
50key_prop(author, dc:creator). 51key_prop(title, rdfs:label). 52key_prop(title, dc:title). 53key_prop(publisher, dc:publisher).
60prefix(dc, 'http://purl.org/dc/elements/1.1/'). 61prefix(rdfs, 'rdfs: <http://www.w3.org/2000/01/rdf-schema#').
68replace_spaces([]) --> eos. 69replace_spaces(S) --> white, whites,!, % red cut 70 replace_spaces(Rest), 71 {append(`_`, Rest, S)}. 72replace_spaces(S) --> alpha_to_lower(C),!, % red cut 73 replace_spaces(Rest), 74 {append([C], Rest, S)}. 75replace_spaces([]) --> [_].
83guess_sufix(Author, Title, Sufix) :-
84 string_codes(Title, TitleCWithSpaces),
85 replace_spaces(TitleCNoSpaces, TitleCWithSpaces, _),
86 atom_codes(TitleA, TitleCNoSpaces),
87 atomic_list_concat([Author, '-', TitleA], Sufix).
paper_prefix/1 is a dynamic predicate. */
96try_paper_prefix(Sufix, Prefix:Sufix) :- 97 paper_prefix(Prefix),!. % red cut. 98try_paper_prefix(Sufix, Sufix). 99 [Author|_Rest], Author) (:- !. 101first_author([Author], Author) :-!.
We need a dynamic predicate paper_prefix/1 defined if a prefix should be used for Subject. */
111guess_subject(entry(_EName, _Label, Fields), Subject) :-
112 member(field(author, Value), Fields),
113 author_field(field(author, Value), LstAuthors),!,
114 first_author(LstAuthors, author(Surname, _AName)),
115 atom_string(SurnameA, Surname),
116 member(field(title, Title), Fields),!,
117 guess_sufix(SurnameA, Title, Sufix),
118 try_paper_prefix(Sufix, Subject).
125bibtex_to_rdf(BibEntry, Graph) :-
126 guess_subject(BibEntry, Subject),
127 rdf_assert(Subject, rdf:type, foaf:'Document', Graph),
128 take_data(Subject, BibEntry, Graph),!.
138take_data(Subject, entry(_Name, _Label, Fields), Graph) :-
139 take_authors(Subject, Fields, Graph),
140 take_title(Subject, Fields, Graph).
150author_suffix(author(SurnameS, NameS), AuthorA) :-
151 string_codes(SurnameS, SurnameC), string_codes(NameS, NameC),
152 append([SurnameC, ` `, NameC], SurnameName),
153 replace_spaces(AuthorC, SurnameName, _),
154 atom_codes(AuthorA, AuthorC),!.
_S, [], _Graph) (. 165assert_authors(S, [AuthorT|Rest], Graph) :- 166 author_suffix(AuthorT, AuthorA), 167 assert_one_author(S, AuthorA, Graph), 168 assert_authors(S, Rest, Graph).
author_prefix/1 is a dynamic predicate.
*/
178assert_one_author(S, Author, Graph) :- 179 author_prefix(Prefix), !, 180 rdf_assert(S, dc:creator, Prefix:Author, Graph). 181assert_one_author(S, Author, Graph) :- 182 rdf_assert(S, dc:creator, Author, Graph).
192take_authors(S, Fields, Graph) :-
193 member(field(author, Value), Fields),
194 author_field(field(author, Value), Authors),
195 assert_authors(S, Authors, Graph).
202take_title(Subject, Fields, Graph) :-
203 member(field(title, Value), Fields),
204 rdf_assert(Subject, dc:title, literal(type(rdfs:string, Value)), Graph),
205 rdf_assert(Subject, rdfs:label, literal(type(rdfs:string, Value)), Graph).
212bibentries_to_rdf([], _). 213bibentries_to_rdf([BibEntry|Rest], Graph) :- 214 bibtex_to_rdf(BibEntry, Graph),!, 215 bibentries_to_rdf(Rest, Graph).
225bibtexfile_to_rdf(BibtexFile, Graph) :-
226 bibtex_file(BibtexFile, LstBibentries),
227 bibentries_to_rdf(LstBibentries, Graph)
bibtex_rdf: BibTex to RDF port.
Predicates for porting a BibTeX file or entry to its RDF simile.