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

bibtex_rdf: BibTex to RDF port.

Predicates for porting a BibTeX file or entry to its RDF simile.

author
- Gimenez, Christian
license
- GPLv3 */
   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.
 key_prop(?BibKey:term, ?RDFProp:term)
A map between a BibTeX key and its RDF property. */
   50key_prop(author, dc:creator).
   51key_prop(title, rdfs:label).
   52key_prop(title, dc:title).
   53key_prop(publisher, dc:publisher).
 prefix(?Prefix:term, ?URL:term)
RDF prefix used. */
   60prefix(dc, 'http://purl.org/dc/elements/1.1/').
   61prefix(rdfs, 'rdfs: <http://www.w3.org/2000/01/rdf-schema#').
 replace_spaces(-Out:codes)//
True iff Out is the same as the input but all its spaces replaced with "_" symbol, and nothing else that lowercase letters. */
   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([]) --> [_].
 guess_sufix(+Author:term, +Title:string, -Sufix:term)
Try to create the IRI Suffix from the author a title of a bibtex. */
   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).
 try_paper_prefix(+Sufix:term, +AbbrvURL:term)
Try to use the Prefix if paper_prefix/1 has one defined, if not use the Sufix itself.

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
  100first_author([Author|_Rest], Author) :- !.
  101first_author([Author], Author) :-!.
 guess_subject(+BibEntry:term, -Subject:term) is det
guess_subject(+BibEntry:term, +Subject:term) is det
True iff Subject is a guessed abbreviated URI we should use for the provided BibEntry.

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).
 bibtex_to_rdf(+BibEntry:term, +Graph:term) is det
Assert all BibTeX fields into the RDF Graph. */
  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),!.
 take_data(+Subject:term, +Entry:term, +Graph:term)
Take important data from the Entry and store it in the semantic graph.
Arguments:
Entry- A BibEntry entry/3.
Graph- An RDF Graph, see rdf_create_graph/1. */
  138take_data(Subject, entry(_Name, _Label, Fields), Graph) :-
  139    take_authors(Subject, Fields, Graph),
  140    take_title(Subject, Fields, Graph).
 author_suffix(+AuthorT:term, -AuthorA:term) is det
True when AuthorA is the suffix needed for the RDF URI to reffer the provided author.
Arguments:
AuthorT- a author/2 term: author(Surname: string, Name: string).
AuthorA- a simple term. */
  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),!.
 assert_authors(+Subject:term, +Authors:list) is det
Associate all the authors from Authors
Arguments:
Subject- a term.
Authors- a list of author/2 terms: author(Surname: string, Name: string). */
  164assert_authors(_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).
 assert_one_author(+S:term, +Author:term, +Graph:term) is det
Assert one Author using the prefix from author_prefix/1. If author_prefix/1 is not defined, don't use preffix.

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).
 take_authors(+S:term, +Fields:list, +Graph:term)
Take authors from the BibTex Fields and store it in the provided RDF graph.
Arguments:
S- the subject term representing the paper.
Fields- is the BibEntry entry/3 field. */
  192take_authors(S, Fields, Graph) :-
  193    member(field(author, Value), Fields),
  194    author_field(field(author, Value), Authors),
  195    assert_authors(S, Authors, Graph).
 take_title(+Subject:term, +Fields:list, +Graph:term)
Add the title to the */
  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).
 bibentries_to_rdf(+BibEntries:list, +Graph:term)
Process a list of BibEntries with bibtex_to_rdf/2. */
  212bibentries_to_rdf([], _).
  213bibentries_to_rdf([BibEntry|Rest], Graph) :-
  214    bibtex_to_rdf(BibEntry, Graph),!,
  215    bibentries_to_rdf(Rest, Graph).
 bibtexfile_to_rdf(+BibtexFile:term, +Graph:term)
Parse the file and store all BibEntries in the Graph.
Arguments:
BibtexFile- A term with the BibTeX file path.
Graph- A RDF graph created with rdf_create_graph/1. */
  225bibtexfile_to_rdf(BibtexFile, Graph) :-
  226    bibtex_file(BibtexFile, LstBibentries),
  227    bibentries_to_rdf(LstBibentries, Graph)