View source with raw comments or as raw
    1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2010, University of Amsterdam,
    7		   VU University Amsterdam
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   30
   31:- module(cpack_repository,
   32	  [ cpack_add_repository/3,	% +User, +GitRepo, +Options
   33	    cpack_update_package/2,	% +User, +Package
   34	    cpack_refresh_metadata/0,
   35	    cpack_refresh_metadata/1,	% +MirrorGit
   36	    cpack_our_mirror/2,		% +Package, -MirrorDir
   37	    cpack_clone_server/3,	% +User, +Server, +Options)
   38	    cpack_uri/3,		% +Type, +Object, -URI
   39	    cpack_log/3,		% +Package, -ShortLog, +Options
   40	    cpack_show/4,		% +Package, +Hash, -Data, +Options
   41	    commit_data/3		% ?Field, ?Record, ?Data
   42	  ]).   43:- use_module(library(lists)).   44:- use_module(library(record)).   45:- use_module(library(git)).   46:- use_module(library(uri)).   47:- use_module(library(settings)).   48:- use_module(library(option)).   49:- use_module(library(error)).   50:- use_module(library(semweb/rdf_db)).   51:- use_module(library(semweb/rdf_turtle)).   52:- use_module(library(semweb/rdf_label)).   53:- use_module(library(semweb/rdf_foaf)).   54:- use_module(library(filesex)).   55:- use_module(library(http/http_wrapper)).   56:- use_module(library(http/http_host)).   57:- use_module(library(http/http_path)).   58:- use_module(library(http/http_open)).   59:- use_module(library(dcg/basics)).   60:- use_module(user(user_db)).   61:- use_module(library(foaf_schema)).   62:- use_module(xref).

Manage CPACK repositories

*/

   70:- setting(cpack:mirrors, atom, 'cpack-mirrors',
   71	   'Directory for mirroring external repositories').   72:- setting(git:http_url, atom, '',
   73	   'Prefix for git HTPP urls').
 cpack_add_repository(+User, +URL, +Options)
Add a git repository from URL. Fetch the meta-data into a graph named cpack:<package> and add a provenance statement that indicates the creator of the graph. Options include:
branch(Branch)
Add the given branch rather than the master
   84cpack_add_repository(User, URL, Options) :-
   85	git_check_url(URL),
   86	url_package(URL, Package),
   87	package_graph(Package, Graph),
   88	file_name_extension(Package, git, BareGit),
   89	setting(cpack:mirrors, MirrorDir),
   90	make_directory_path(MirrorDir),
   91	directory_file_path(MirrorDir, BareGit, BareGitPath),
   92	(   exists_directory(BareGitPath)
   93	->  cpack_update_repository(User, URL, Options)
   94	;   git([clone, '--mirror', URL, BareGitPath], []),
   95	    rdf_assert(User, cpack:submitted, Graph, User),
   96	    update_metadata(BareGitPath, Graph,
   97			    [user(User),cloned(URL)|Options])
   98	).
 git_check_url(+URL) is det
Verify that the URL is either git://, http:// or https://. Notaby, avoid SSH URLs that would make the ClioPatria server try ssh connections that would normally not be allowed.
Errors
- (permission_error(add_repository_from, url, URL)
  108git_check_url(URL) :-
  109	uri_components(URL, Components),
  110	uri_data(scheme, Components, Scheme),
  111	safe_scheme(Scheme), !.
  112git_check_url(URL) :-
  113	permission_error(add_repository_from,
  114			 url,
  115			 URL).
  116
  117safe_scheme(git).
  118safe_scheme(http).
  119safe_scheme(https).
 cpack_update_package(+User, +Package) is det
Update the given package.
  126cpack_update_package(User, Package) :-
  127	rdf_has(Package, cpack:clonedRepository, Cloned),
  128	rdf_has(Cloned,  cpack:gitURL, GitURL),
  129	(   rdf_has(Cloned, cpack:branch, literal(Branch))
  130	->  true
  131	;   Branch = master
  132	),
  133	cpack_update_repository(User, GitURL,
  134				[ branch(Branch),
  135				  allowed(true)
  136				]).
 cpack_update_repository(+User, +URL)
Update a package
  143cpack_update_repository(User, URL, Options) :-
  144	option(branch(Branch), Options, master),
  145	url_package(URL, PackageName),
  146	package_graph(PackageName, Graph),
  147	Package = Graph,
  148	update_allowed(User, Package, Options),
  149	file_name_extension(PackageName, git, BareGit),
  150	setting(cpack:mirrors, MirrorDir),
  151	directory_file_path(MirrorDir, BareGit, BareGitPath),
  152	git_hash(BareGitPath, master, Hash0),
  153	atomic_list_concat([Branch, master], :, BranchSpec),
  154	git([fetch, URL, BranchSpec], [directory(BareGitPath)]),
  155	git_hash(BareGitPath, master, Hash1),
  156	print_message(informational, cpack(updated(Graph, Hash0, Hash1))),
  157	(   (   Hash1 \== Hash0
  158	    ;	option(update_metadata(always), Options, always)
  159	    )
  160	->  update_metadata(BareGitPath, Graph,
  161			    [user(User),cloned(URL)|Options])
  162	;   true
  163	).
  164
  165update_allowed(_, _, Options) :-
  166	option(allowed(true), Options), !.
  167update_allowed(User, Package, _) :-
  168	rdf(User, cpack:submitted, Package, User), !.
  169update_allowed(_, _, _) :-
  170	catch(authorized(admin(cpack)), _, fail).
  171update_allowed(_, Package, _) :-
  172	permission_error(update, cpack, Package).
 update_metadata(+BareGitPath, +Graph, +Options) is det
Update metadata for a repository
  179update_metadata(BareGitPath, Graph, Options) :-
  180	rdf_retractall(_,_,_,Graph),
  181	add_files(BareGitPath, Graph, Options),
  182	catch(load_meta_data(BareGitPath, Graph, Options), E,
  183	      print_message(error, E)),
  184	update_decription(BareGitPath, Graph),
  185	add_timestamp(Graph, Options),
  186	option(branch(Branch), Options, master),
  187	git_hash(BareGitPath, Branch, Hash),
  188	(   option(cloned(ClonedURL), Options)
  189	->  rdf_bnode(Cloned),
  190	    rdf_assert(Graph, cpack:clonedRepository, Cloned, Graph),
  191	    rdf_assert(Cloned, rdf:type, cpack:'Repository', Graph),
  192	    rdf_assert(Cloned, cpack:gitURL, ClonedURL, Graph),
  193	    rdf_assert(Cloned, cpack:branch, literal(Branch), Graph),
  194	    rdf_assert(Cloned, cpack:hash, literal(Hash), Graph)
  195	;   true
  196	),
  197	(   git_export(BareGitPath, MirroredURL)
  198	->  rdf_bnode(Mirror),
  199	    rdf_assert(Graph, cpack:mirrorRepository, Mirror, Graph),
  200	    rdf_assert(Mirror, rdf:type, cpack:'Repository', Graph),
  201	    rdf_assert(Mirror, cpack:gitURL, MirroredURL, Graph),
  202	    rdf_assert(Mirror, cpack:branch, literal(Branch), Graph),
  203	    rdf_assert(Mirror, cpack:hash, literal(Hash), Graph)
  204	;   true
  205	),
  206	foaf_merge(_),
  207	set_prolog_flag(message_ide, false),	% do not expose messages
  208	xref_cpack(Graph).
  209
  210add_timestamp(Graph, Options) :-
  211	option(submitted_date(DateTime), Options), !,
  212	rdf_assert(Graph, cpack:submittedDate, DateTime, Graph).
  213add_timestamp(Graph, _Options) :-
  214	get_time(Now),
  215	format_time(atom(DateTime), '%FT%T%Oz', Now),
  216	rdf_assert(Graph, cpack:submittedDate,
  217		   literal(type(xsd:dateTime, DateTime)), Graph).
  218
  219update_decription(BareGitPath, Graph) :-
  220	rdf_has(Graph, dcterms:title, Literal), !,
  221	literal_text(Literal, Title),
  222	directory_file_path(BareGitPath, description, DescFile),
  223	setup_call_cleanup(open(DescFile, write, Out),
  224			   format(Out, '~w~n', [Title]),
  225			   close(Out)).
  226update_decription(_, _).
 git_export(+BareGitPath, -MirroredURL) is det
Make sure git-daemon-export-ok exists and deduce the URL for cloning using http://
To be done
- Make path for http repos configurable
  235git_export(BareGitPath, MirroredURL) :-
  236	(   setting(git:http_url, Prefix),
  237	    Prefix \== ''
  238	->  true
  239	;   (   setting(http:public_host, Public)
  240	    ->  GitHost = Public
  241	    ;   gethostname(GitHost)
  242	    ),
  243	    format(string(Prefix), 'http://~w/git/cpack-mirrors/', [GitHost])
  244	),
  245	file_base_name(BareGitPath, RepoDir),
  246	format(atom(MirroredURL), '~w~w', [Prefix, RepoDir]),
  247	directory_file_path(BareGitPath, 'git-daemon-export-ok', ExportOK),
  248	(   exists_file(ExportOK)
  249	->  true
  250	;   setup_call_cleanup(
  251		open(ExportOK, write, Out),
  252		true,
  253		close(Out))
  254	).
 git_hash(+BareGitPath, +RevSpec, -Hash) is det
Add a cpack:hash to the repository.
  261git_hash(BareGitPath, RevSpec, Hash) :-
  262	git_process_output(['rev-parse', RevSpec],
  263			   read_to_atom(Hash),
  264			   [directory(BareGitPath)]).
  265
  266read_to_atom(Hash, In) :-
  267	read_line_to_codes(In, Line),
  268	atom_codes(Hash, Line).
 add_files(+BareGitPath, +Graph, +Options) is det
Add objects for the files in BareGitPath to Graph.
  274add_files(BareGitPath, Graph, Options) :-
  275	option(branch(Branch), Options, master),
  276	git_process_output(['ls-tree', '-lr', Branch],
  277			   read_files(Graph),
  278			   [directory(BareGitPath)]),
  279	process_ignore_files(BareGitPath, Graph, Options).
  280
  281read_files(Graph, In) :-
  282	read_line_to_codes(In, Line1),
  283	read_files(Line1, Graph, In).
  284
  285read_files(end_of_file, _, _) :- !.
  286read_files(Line, Graph, In) :-
  287	(   read_file(Line, Graph)
  288	->  true
  289	;   gtrace,
  290	    read_file(Line, Graph)
  291	),
  292	read_line_to_codes(In, Line2),
  293	read_files(Line2, Graph, In).
  294
  295read_file(Line, Graph) :-
  296	phrase(file_l(_Mode, _Type, _Hash, Size, FileName), Line), !,
  297	atom_number(SizeAtom, Size),
  298	file_base_name(FileName, BaseName),
  299	file_base(FileName , BaseID),
  300	file_type(BaseName, Class),
  301	atomic_list_concat([Graph, /, FileName], File),
  302	rdf_assert(File, cpack:path, literal(FileName), Graph),
  303	rdf_assert(File, cpack:name, literal(BaseName), Graph),
  304	rdf_assert(File, cpack:base, literal(BaseID), Graph),
  305	rdf_assert(File, cpack:size, literal(type(xsd:integer, SizeAtom)), Graph),
  306	rdf_assert(File, cpack:inPack, Graph, Graph),
  307	rdf_assert(File, rdf:type, Class, Graph).
  308read_file(Line, _Graph) :-
  309	string_codes(String, Line),
  310	print_message(warning, cpack(ignored_git_entry(String))).
  311
  312file_base(Path, Base) :-
  313	file_base_name(Path, File),
  314	file_name_extension(Base, _Ext, File).
  315
  316file_l(Mode, Type, Hash, Size, Name) -->
  317	string_without(" ", MCodes), blanks,
  318	string_without(" ", TCodes), blanks,
  319	string_without(" ", HCodes), blanks,
  320	integer(Size), blanks,
  321	string_without(" \n", NCodes), blanks,
  322	{ number_codes(Mode, [0'0, 0'o|MCodes]),
  323	  atom_codes(Type, TCodes),
  324	  atom_codes(Hash, HCodes),
  325	  atom_codes(Name, NCodes)
  326	}.
  327
  328
  329:- rdf_meta
  330	file_type(+, r).  331
  332file_type(File, cpack:'PrologFile') :-
  333	file_name_extension(_Base, Ext, File),
  334	user:prolog_file_type(Ext, prolog), !.
  335file_type(File, cpack:'IgnoreFile') :-
  336	file_base_name(File, '.cpackignore'), !.
  337file_type(_, cpack:'File').
 process_ignore_files(+BareGitPath, +Graph, +Options)
Allow for .cpackignore files that specify that certain files should not be analysed.
  345process_ignore_files(BareGitPath, Graph, Options) :-
  346	forall(rdf(IgnFile, rdf:type, cpack:'IgnoreFile', Graph),
  347	       process_ignore_file(IgnFile, BareGitPath, Graph, Options)).
  348
  349process_ignore_file(IgnFile, BareGitPath, Graph, Options) :-
  350	option(branch(Branch), Options, master),
  351	rdf(IgnFile, cpack:path, literal(Path)),
  352	file_directory_name(Path, Dir),
  353	setup_call_cleanup(
  354	    git_open_file(BareGitPath, Path, Branch, In),
  355	    load_ignore_data(In, Dir, Graph),
  356	    close(In)).
  357
  358load_ignore_data(In, Dir, Graph) :-
  359	read_line_to_string(In, Line),
  360	load_ignore_data(Line, In, Dir, Graph).
  361
  362load_ignore_data(end_of_file, _, _, _) :- !.
  363load_ignore_data(Line, In, Dir, Graph) :-
  364	directory_file_path(Dir, Line, Pattern),
  365	forall(( rdf(File, cpack:path, literal(Path), Graph),
  366		 wildcard_match(Pattern, Path)
  367	       ),
  368	       rdf_assert(File, cpack:ignored, literal(type(xsd:boolean, true)))),
  369	read_line_to_string(In, Line2),
  370	load_ignore_data(Line2, In, Dir, Graph).
 load_meta_data(+BareGitPath, +Graph, +Options) is det
Load the meta-data from the GIT repository BareGitPath into the named graph Graph.
  378load_meta_data(BareGitPath, Graph, Options) :-
  379	option(branch(Branch), Options, master),
  380	url_package(BareGitPath, Package),
  381	format(atom(File), '~w:rdf/cpack/~w.ttl', [Branch, Package]),
  382	git_process_output([show, File],
  383			   rdf_load_git_stream(Graph),
  384			   [directory(BareGitPath)]).
  385
  386rdf_load_git_stream(Graph, In) :-
  387	set_stream(In, file_name(Graph)),
  388	atom_concat('__', Graph, BNodePrefix),
  389	rdf_read_turtle(stream(In),
  390			RDF,
  391			[ base_uri(Graph),
  392			  anon_prefix(BNodePrefix)
  393			]),
  394	forall(member(rdf(S,P,O), RDF),
  395	       rdf_assert(S,P,O,Graph)).
  396
  397
  398		 /*******************************
  399		 *	UPDATE FROM MIRROR	*
  400		 *******************************/
 cpack_refresh_metadata(+BareGitPath) is det
Regenerate the metadata associated with BareGitPath from the plain (mirrored) git repository.
  407cpack_refresh_metadata(BareGitPath) :-
  408	file_base_name(BareGitPath, BareGit),
  409	file_name_extension(PackageName, git, BareGit),
  410	package_graph(PackageName, Graph),
  411	GitOptions = [askpass(path(echo)), directory(BareGitPath)],
  412	(   git_remote_url(origin, Origin, GitOptions),
  413	    git_default_branch(DefBranch, GitOptions)
  414	->  Options = [ cloned(Origin),
  415			branch(DefBranch)
  416		      | Extra
  417		      ]
  418	;   Options = Extra
  419	),
  420	(   rdf_has(Graph, cpack:submittedDate, Date)
  421	->  Extra = [submitted_date(Date)]
  422	;   Extra = []
  423	),
  424	update_metadata(BareGitPath, Graph, Options).
 cpack_refresh_metadata
Rebuild all (xref) metadata for all packages from scratch. This is intended to deal with changes to the metadata formats, lost GIT mirrors, etc.
  432cpack_refresh_metadata :-
  433	setting(cpack:mirrors, MirrorDir),
  434	directory_file_path(MirrorDir, '*.git', Pattern),
  435	expand_file_name(Pattern, BareGits),
  436	clear_xref_graphs,
  437	maplist(cpack_refresh_metadata, BareGits).
  438
  439clear_xref_graphs :-
  440	clear_xref_graph(prolog),
  441	clear_xref_graph(cliopatria),
  442	clear_xref_graph('file-references').
  443
  444clear_xref_graph(Name) :-
  445	cpack_uri(graph, Name, URI),
  446	rdf_retractall(_,_,_,URI).
  447
  448
  449		 /*******************************
  450		 *	  CLONE A SERVER	*
  451		 *******************************/
 cpack_clone_server(+User, +Server, +Options)
Clone all packages from Server.
  457cpack_clone_server(User, Server, _Options) :-
  458	atom_concat(Server, '/cpack/clone_data', CloneURL),
  459	http_prolog_data(CloneURL, Terms),
  460	forall(member(PackInfo, Terms),
  461	       clone_package(User, PackInfo)).
 clone_package(+User, +PackInfo)
Clone package from another server.
  467clone_package(User, cpack(Name, Options)) :-
  468	print_message(informational, cpack(clone(Name, Options))),
  469	option(pack_repository(git(GitURL, GitOptions)), Options),
  470	cpack_add_repository(User, GitURL, GitOptions).
 http_prolog_data(+URL, -Term) is det
Read a Prolog term from URL.
  476http_prolog_data(URL, Terms) :-
  477	setup_call_cleanup(http_open(URL, In, []),
  478			   read_stream_to_terms(In, Terms),
  479			   close(In)).
  480
  481read_stream_to_terms(In, Terms) :-
  482	read_term(In, Term0, []),
  483	read_stream_to_terms(Term0, In, Terms).
  484
  485read_stream_to_terms(end_of_file, _, []) :- !.
  486read_stream_to_terms(Term, In, [Term|T]) :-
  487	read_term(In, Term1, []),
  488	read_stream_to_terms(Term1, In, T).
  489
  490
  491
  492		 /*******************************
  493		 *	       URIs		*
  494		 *******************************/
 cpack_uri(+Type, +Identifier, -URI) is det
Create a persistent URI for Identifier of the given Type.
  500cpack_uri(Type, Name, URI) :-
  501	(   type_root(Type, RootSpec)
  502	->  http_absolute_location(RootSpec, Root0, []),
  503	    ensure_slash(Root0, Root)
  504	;   domain_error(uri_type, Type)
  505	),
  506	http_current_request(Request),
  507	http_current_host(Request, Host, Port,
  508			  [ global(true)
  509			  ]),
  510	scheme(Scheme, DefaultPort),
  511	uri_authority_data(host, AD, Host),
  512	(   Port =:= DefaultPort
  513	->  true
  514	;   uri_authority_data(port, AD, Port)
  515	),
  516	uri_authority_components(Authority, AD),
  517	uri_data(scheme, Data, Scheme),
  518	uri_data(authority, Data, Authority),
  519	uri_data(path, Data, Root),
  520	uri_components(Start, Data),
  521	atom_concat(Start, Name, URI).
  522
  523scheme(Scheme, Port) :-
  524	setting(http:public_scheme, Scheme), !,
  525	scheme_default_port(Scheme, Port).
  526scheme(http, 80).
  527
  528scheme_default_port(https, 443).
  529scheme_default_port(http, 80).
  530
  531ensure_slash(Root0, Root) :-
  532	(   sub_atom(Root0, _, _, 0, /)
  533	->  Root = Root0
  534	;   atom_concat(Root0, /, Root)
  535	).
  536
  537type_root(package,    root(packs)).
  538type_root(pack,	      root(cpack)).		% Sync with api(cpack)!
  539type_root(file_ref,   root(file_ref)).
  540type_root(graph,      root(graph)).
  541type_root(prolog,     root(prolog)).
  542type_root(cliopatria, root(cliopatria)).
  543
  544package_graph(Package, Graph) :-
  545	cpack_uri(package, Package, Graph).
  546
  547url_package(URL, Package) :-
  548	file_base_name(URL, Base),
  549	(   atom_concat(Package0, '.git', Base)
  550	->  Package = Package0
  551	;   Package = Base
  552	).
  553
  554		 /*******************************
  555		 *	     FETCH INFO		*
  556		 *******************************/
 cpack_our_mirror(+Pack, -Dir) is det
Dir is the directory holding the bare git repository for Pack.
  562cpack_our_mirror(Pack, BareGitPath) :-
  563	rdf_has(Pack, cpack:packageName, literal(PackageName)),
  564	file_name_extension(PackageName, git, BareGit),
  565	setting(cpack:mirrors, MirrorDir),
  566	directory_file_path(MirrorDir, BareGit, BareGitPath).
  567
  568
  569		 /*******************************
  570		 *	  GIT OPERATIONS	*
  571		 *******************************/
 cpack_log(+Pack, -ShortLog, Options) is det
Fetch information like the GitWeb change overview. Processed options:
limit(+Count)
Maximum number of commits to show (default is 10)
git_path(+Path)
Only show commits that affect Path
Arguments:
ShortLog- is a list of git_log records. See git_shortlog/3.
  586cpack_log(Pack, ShortLog, Options) :-
  587	cpack_our_mirror(Pack, BareGitPath),
  588	git_shortlog(BareGitPath, ShortLog, Options).
 cpack_show(+Pack, +Hash, -Commit) is det
Fetch info from a GIT commit. Options processed:
diff(Diff)
GIT option on how to format diffs. E.g. stat
max_lines(Count)
Truncate the body at Count lines.
Arguments:
Commit- is a term git_commit(...)-Body. Body is currently a list of lines, each line represented as a list of codes.
  604:- record
  605	commit(tree_hash:atom,
  606	       parent_hashes:list,
  607	       author_name:atom,
  608	       author_date:atom,
  609	       committer_name:atom,
  610	       committer_date:atom,
  611	       subject:atom).  612
  613cpack_show(Pack, Hash, Commit, Options) :-
  614	cpack_our_mirror(Pack, BareGitPath),
  615	git_format_string(commit, Fields, Format),
  616	option(diff(Diff), Options, patch),
  617	diff_arg(Diff, DiffArg),
  618	git_process_output([ show, DiffArg, Hash, Format ],
  619			   read_commit(Fields, Commit, Options),
  620			   [directory(BareGitPath)]).
  621
  622diff_arg(patch, '-p').
  623diff_arg(stat, '--stat').
  624
  625read_commit(Fields, Data-Body, Options, In) :-
  626	read_line_to_codes(In, Line1),
  627	record_from_line(commit, Fields, Line1, Data),
  628	read_line_to_codes(In, Line2),
  629	Line2 == [],
  630	option(max_lines(Max), Options, -1),
  631	read_n_lines(In, Max, Body).
  632
  633read_n_lines(In, Max, Lines) :-
  634	read_line_to_codes(In, Line1),
  635	read_n_lines(Line1, Max, In, Lines).
  636
  637read_n_lines(end_of_file, _, _, []) :- !.
  638read_n_lines(_, 0, In, []) :- !,
  639	setup_call_cleanup(open_null_stream(Out),
  640			   copy_stream_data(In, Out),
  641			   close(Out)).
  642read_n_lines(Line, Max0, In, [Line|More]) :-
  643	read_line_to_codes(In, Line2),
  644	Max is Max0-1,
  645	read_n_lines(Line2, Max, In, More).
  646
  647
  648record_from_line(RecordName, Fields, Line, Record) :-
  649	phrase(fields_from_line(Fields, Values), Line),
  650	Record =.. [RecordName|Values].
  651
  652fields_from_line([], []) --> [].
  653fields_from_line([F|FT], [V|VT]) -->
  654	to_nul_s(Codes),
  655	{ field_to_prolog(F, Codes, V) },
  656	fields_from_line(FT, VT).
  657
  658to_nul_s([]) --> [0], !.
  659to_nul_s([H|T]) --> [H], to_nul_s(T).
  660
  661field_to_prolog(ref_names, Line, List) :-
  662	phrase(ref_names(List), Line), !.
  663field_to_prolog(_, Line, Atom) :-
  664	atom_codes(Atom, Line).
  665
  666ref_names([]) --> [].
  667ref_names(List) -->
  668	blanks, "(", ref_name_list(List), ")".
  669
  670ref_name_list([H|T]) -->
  671	string_without(",)", Codes),
  672	{ atom_codes(H, Codes) },
  673	(   ",", blanks
  674	->  ref_name_list(T)
  675	;   {T=[]}
  676	).
 git_format_string(+Record, -FieldNames, -Format)
If Record is a record with fields whose names match the GIT format field-names, Format is a git --format= argument with the appropriate format-specifiers, terminated by %x00, which causes the actual field to be 0-terminated.
  685:- meta_predicate
  686	git_format_string(:, -, -).  687
  688git_format_string(M:RecordName, Fields, Format) :-
  689	current_record(RecordName, M:Term),
  690	findall(F, record_field(Term, F), Fields),
  691	maplist(git_field_format, Fields, Formats),
  692	atomic_list_concat(['--format='|Formats], Format).
  693
  694record_field(Term, Name) :-
  695	arg(_, Term, Field),
  696	field_name(Field, Name).
  697
  698field_name(Name:_Type=_Default, Name) :- !.
  699field_name(Name:_Type, Name) :- !.
  700field_name(Name=_Default, Name) :- !.
  701field_name(Name, Name).
  702
  703git_field_format(Field, Fmt) :-
  704	(   git_format(NoPercent, Field)
  705	->  atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
  706	;   existence_error(git_format, Field)
  707	).
  708
  709git_format('H', commit_hash).
  710git_format('h', abbreviated_commit_hash).
  711git_format('T', tree_hash).
  712git_format('t', abbreviated_tree_hash).
  713git_format('P', parent_hashes).
  714git_format('p', abbreviated_parent_hashes).
  715
  716git_format('an', author_name).
  717git_format('aN', author_name_mailcap).
  718git_format('ae', author_email).
  719git_format('aE', author_email_mailcap).
  720git_format('ad', author_date).
  721git_format('aD', author_date_rfc2822).
  722git_format('ar', author_date_relative).
  723git_format('at', author_date_unix).
  724git_format('ai', author_date_iso8601).
  725
  726git_format('cn', committer_name).
  727git_format('cN', committer_name_mailcap).
  728git_format('ce', committer_email).
  729git_format('cE', committer_email_mailcap).
  730git_format('cd', committer_date).
  731git_format('cD', committer_date_rfc2822).
  732git_format('cr', committer_date_relative).
  733git_format('ct', committer_date_unix).
  734git_format('ci', committer_date_iso8601).
  735
  736git_format('d', ref_names).		% git log?
  737git_format('e', encoding).		% git log?
  738
  739git_format('s', subject).
  740git_format('f', subject_sanitized).
  741git_format('b', body).
  742git_format('N', notes).
  743
  744git_format('gD', reflog_selector).
  745git_format('gd', shortened_reflog_selector).
  746git_format('gs', reflog_subject).
  747
  748
  749		 /*******************************
  750		 *	      MESSAGES		*
  751		 *******************************/
  752
  753:- multifile prolog:message//1.  754
  755prolog:message(cpack(updated(Graph, Hash0, Hash1))) -->
  756	package_name(Graph),
  757	(   { Hash0 == Hash1 }
  758	->  [ ' no change'-[] ]
  759	;   { sub_atom(Hash0, 0, 6, _, Short0),
  760	      sub_atom(Hash1, 0, 6, _, Short1)
  761	    },
  762	    [ ' g~w..g~w'-[Short0,Short1] ]
  763	).
  764prolog:message(cpack(clone(Name, _Options))) -->
  765	[ 'Cloning CPACK ~w ...'-[Name] ].
  766prolog:message(cpack(ignored_git_entry(Line))) -->
  767	[ 'Ignored GIT entry "~s"'-[Line] ].
  768
  769package_name(Graph) -->
  770	{ rdf_has(Graph, cpack:name, Literal),
  771	  literal_text(Literal, Text)
  772	}, !,
  773	[ '~w'-[Text] ].
  774package_name(Graph) -->
  775	[ '~p'-[Graph] ]