1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c) 2010-2013, University of Amsterdam,
    7                             VU University
    8    Amsterdam All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(git,
   37          [ git/2,                      % +Argv, +Options
   38            git_process_output/3,       % +Argv, :OnOutput, +Options
   39            git_open_file/4,            % +Dir, +File, +Branch, -Stream
   40            is_git_directory/1,         % +Dir
   41            git_describe/2,             % -Version, +Options
   42            git_hash/2,                 % -Hash, +Options
   43            git_ls_tree/2,              % -Content, +Options
   44            git_remote_url/3,           % +Remote, -URL, +Options
   45            git_ls_remote/3,            % +GitURL, -Refs, +Options
   46            git_branches/2,             % -Branches, +Options
   47            git_remote_branches/2,      % +GitURL, -Branches
   48            git_default_branch/2,       % -DefaultBranch, +Options
   49            git_tags_on_branch/3,       % +Dir, +Branch, -Tags
   50            git_shortlog/3,             % +Dir, -Shortlog, +Options
   51            git_log_data/3,             % +Field, +Record, -Value
   52            git_show/4,                 % +Dir, +Hash, -Commit, +Options
   53            git_commit_data/3           % +Field, +Record, -Value
   54          ]).   55:- use_module(library(record),[(record)/1,current_record/2, op(_,_,record)]).   56
   57:- autoload(library(apply),[maplist/3]).   58:- autoload(library(error),[must_be/2,existence_error/2]).   59:- autoload(library(filesex),
   60	    [directory_file_path/3,relative_file_name/3]).   61:- autoload(library(lists),[append/3,member/2,append/2]).   62:- autoload(library(option),[option/2,option/3,select_option/3]).   63:- autoload(library(process),[process_create/3,process_wait/2]).   64:- autoload(library(readutil),
   65	    [ read_stream_to_codes/3,
   66	      read_line_to_codes/2,
   67	      read_stream_to_codes/2
   68	    ]).   69:- autoload(library(dcg/basics),
   70	    [string//1,whites//0,string_without//2,blanks//0]).   71
   72
   73:- meta_predicate
   74    git_process_output(+, 1, +).   75
   76/** <module> Run GIT commands
   77
   78This module performs common GIT tasks by calling git as a remote process
   79through process_create/3. It requires that the =git= executable is in the
   80current PATH.
   81
   82This module started life in ClioPatria and   has been used by the Prolog
   83web-server to provide information on git   repositories. It is now moved
   84into the core Prolog library to support the Prolog package manager.
   85*/
   86
   87:- predicate_options(git/2, 2,
   88                     [ directory(atom),
   89                       error(-codes),
   90                       output(-codes),
   91                       status(-any),
   92                       askpass(any)
   93                     ]).   94:- predicate_options(git_default_branch/2, 2,
   95                     [ pass_to(git_process_output/3, 3)
   96                     ] ).   97:- predicate_options(git_describe/2, 2,
   98                     [ commit(atom),
   99                       directory(atom),
  100                       match(atom)
  101                     ]).  102:- predicate_options(git_hash/2, 2,
  103                     [ commit(atom),
  104                       directory(atom),
  105                       pass_to(git_process_output/3, 3)
  106                     ]).  107:- predicate_options(git_ls_tree/2, 2,
  108                     [ commit(atom),
  109                       directory(atom)
  110                     ]).  111:- predicate_options(git_process_output/3, 3,
  112                     [ directory(atom),
  113                       askpass(any),
  114                       error(-codes)
  115                     ]).  116:- predicate_options(git_remote_url/3, 3,
  117                     [ pass_to(git_process_output/3, 3)
  118                     ]).  119:- predicate_options(git_shortlog/3, 3,
  120                     [ revisions(atom),
  121                       limit(nonneg),
  122                       path(atom)
  123                     ]).  124:- predicate_options(git_show/4, 4,
  125                     [ diff(oneof([patch,stat]))
  126                     ]).  127
  128
  129%!  git(+Argv, +Options) is det.
  130%
  131%   Run a GIT command.  Defined options:
  132%
  133%     * directory(+Dir)
  134%     Execute in the given directory
  135%     * output(-Out)
  136%     Unify Out with a list of codes representing stdout of the
  137%     command.  Otherwise the output is handed to print_message/2
  138%     with level =informational=.
  139%     * error(-Error)
  140%     As output(Out), but messages are printed at level =error=.
  141%     * askpass(+Program)
  142%     Export GIT_ASKPASS=Program
  143
  144git(Argv, Options) :-
  145    git_cwd_options(Argv, Argv1, Options),
  146    env_options(Extra, Options),
  147    setup_call_cleanup(
  148        process_create(path(git), Argv1,
  149                       [ stdout(pipe(Out)),
  150                         stderr(pipe(Error)),
  151                         process(PID)
  152                       | Extra
  153                       ]),
  154        call_cleanup(
  155            ( read_stream_to_codes(Out, OutCodes, []),
  156              read_stream_to_codes(Error, ErrorCodes, [])
  157            ),
  158            process_wait(PID, Status)),
  159        close_streams([Out,Error])),
  160    print_error(ErrorCodes, Options),
  161    print_output(OutCodes, Options),
  162    (   option(status(Status0), Options)
  163    ->  Status = Status0
  164    ;   Status == exit(0)
  165    ->  true
  166    ;   throw(error(process_error(git(Argv), Status), _))
  167    ).
  168
  169git_cwd_options(Argv0, Argv, Options) :-
  170    option(directory(Dir), Options),
  171    !,
  172    Argv = ['-C', file(Dir) | Argv0 ].
  173git_cwd_options(Argv, Argv, _).
  174
  175env_options([env(['GIT_ASKPASS'=Program])], Options) :-
  176    option(askpass(Exe), Options),
  177    !,
  178    exe_options(ExeOptions),
  179    absolute_file_name(Exe, PlProg, ExeOptions),
  180    prolog_to_os_filename(PlProg, Program).
  181env_options([], _).
  182
  183exe_options(Options) :-
  184    current_prolog_flag(windows, true),
  185    !,
  186    Options = [ extensions(['',exe,com]), access(read) ].
  187exe_options(Options) :-
  188    Options = [ access(execute) ].
  189
  190print_output(OutCodes, Options) :-
  191    option(output(Codes), Options),
  192    !,
  193    Codes = OutCodes.
  194print_output([], _) :- !.
  195print_output(OutCodes, _) :-
  196    print_message(informational, git(output(OutCodes))).
  197
  198print_error(OutCodes, Options) :-
  199    option(error(Codes), Options),
  200    !,
  201    Codes = OutCodes.
  202print_error([], _) :- !.
  203print_error(OutCodes, _) :-
  204    phrase(classify_message(Level), OutCodes, _),
  205    print_message(Level, git(output(OutCodes))).
  206
  207classify_message(error) -->
  208    string(_), "fatal:",
  209    !.
  210classify_message(error) -->
  211    string(_), "error:",
  212    !.
  213classify_message(warning) -->
  214    string(_), "warning:",
  215    !.
  216classify_message(informational) -->
  217    [].
  218
  219%!  close_streams(+Streams:list) is det.
  220%
  221%   Close a list of streams, throwing the first error if some stream
  222%   failed to close.
  223
  224close_streams(List) :-
  225    phrase(close_streams(List), Errors),
  226    (   Errors = [Error|_]
  227    ->  throw(Error)
  228    ;   true
  229    ).
  230
  231close_streams([H|T]) -->
  232    { catch(close(H), E, true) },
  233    (   { var(E) }
  234    ->  []
  235    ;   [E]
  236    ),
  237    close_streams(T).
  238
  239
  240%!  git_process_output(+Argv, :OnOutput, +Options) is det.
  241%
  242%   Run a git-command and process the output with OnOutput, which is
  243%   called as call(OnOutput, Stream).
  244
  245git_process_output(Argv, OnOutput, Options) :-
  246    git_cwd_options(Argv, Argv1, Options),
  247    env_options(Extra, Options),
  248    setup_call_cleanup(
  249        process_create(path(git), Argv1,
  250                       [ stdout(pipe(Out)),
  251                         stderr(pipe(Error)),
  252                         process(PID)
  253                       | Extra
  254                       ]),
  255        call_cleanup(
  256            ( call(OnOutput, Out),
  257              read_stream_to_codes(Error, ErrorCodes, [])
  258            ),
  259            git_wait(PID, Out, Status)),
  260        close_streams([Out,Error])),
  261    print_error(ErrorCodes, Options),
  262    (   Status = exit(0)
  263    ->  true
  264    ;   throw(error(process_error(git, Status)))
  265    ).
  266
  267git_wait(PID, Out, Status) :-
  268    at_end_of_stream(Out),
  269    !,
  270    process_wait(PID, Status).
  271git_wait(PID, Out, Status) :-
  272    setup_call_cleanup(
  273        open_null_stream(Null),
  274        copy_stream_data(Out, Null),
  275        close(Null)),
  276    process_wait(PID, Status).
  277
  278
  279%!  git_open_file(+GitRepoDir, +File, +Branch, -Stream) is det.
  280%
  281%   Open the file File in the given bare GIT repository on the given
  282%   branch (treeisch).
  283%
  284%   @bug    We cannot tell whether opening failed for some reason.
  285
  286git_open_file(Dir, File, Branch, In) :-
  287    atomic_list_concat([Branch, :, File], Ref),
  288    process_create(path(git),
  289                   [ '-C', file(Dir), show, Ref ],
  290                   [ stdout(pipe(In))
  291                   ]),
  292    set_stream(In, file_name(File)).
  293
  294
  295%!  is_git_directory(+Directory) is semidet.
  296%
  297%   True if Directory is a  git   directory  (Either  checked out or
  298%   bare).
  299
  300is_git_directory(Directory) :-
  301    directory_file_path(Directory, '.git', GitDir),
  302    exists_directory(GitDir),
  303    !.
  304is_git_directory(Directory) :-
  305    exists_directory(Directory),
  306    git(['rev-parse', '--git-dir'],
  307        [ output(Codes),
  308          error(_),
  309          status(Status),
  310          directory(Directory)
  311        ]),
  312    Status == exit(0),
  313    string_codes(GitDir0, Codes),
  314    split_string(GitDir0, "", " \n", [GitDir]),
  315    sub_string(GitDir, B, _, A, "/.git/modules/"),
  316    !,
  317    sub_string(GitDir, 0, B, _, Main),
  318    sub_string(GitDir, _, A, 0, Below),
  319    directory_file_path(Main, Below, Dir),
  320    same_file(Dir, Directory).
  321
  322%!  git_describe(-Version, +Options) is semidet.
  323%
  324%   Describe the running version  based  on   GIT  tags  and hashes.
  325%   Options:
  326%
  327%       * match(+Pattern)
  328%       Only use tags that match Pattern (a Unix glob-pattern; e.g.
  329%       =|V*|=)
  330%       * directory(Dir)
  331%       Provide the version-info for a directory that is part of
  332%       a GIT-repository.
  333%       * commit(+Commit)
  334%       Describe Commit rather than =HEAD=
  335%
  336%   @see git describe
  337
  338git_describe(Version, Options) :-
  339    (   option(match(Pattern), Options)
  340    ->  true
  341    ;   git_version_pattern(Pattern)
  342    ),
  343    (   option(commit(Commit), Options)
  344    ->  Extra = [Commit]
  345    ;   Extra = []
  346    ),
  347    option(directory(Dir), Options, .),
  348    setup_call_cleanup(
  349        process_create(path(git),
  350                       [ 'describe',
  351                         '--match', Pattern
  352                       | Extra
  353                       ],
  354                       [ stdout(pipe(Out)),
  355                         stderr(null),
  356                         process(PID),
  357                         cwd(Dir)
  358                       ]),
  359        call_cleanup(
  360            read_stream_to_codes(Out, V0, []),
  361            git_wait(PID, Out, Status)),
  362        close(Out)),
  363    Status = exit(0),
  364    !,
  365    atom_codes(V1, V0),
  366    normalize_space(atom(Plain), V1),
  367    (   git_is_clean(Dir)
  368    ->  Version = Plain
  369    ;   atom_concat(Plain, '-DIRTY', Version)
  370    ).
  371git_describe(Version, Options) :-
  372    option(directory(Dir), Options, .),
  373    option(commit(Commit), Options, 'HEAD'),
  374    setup_call_cleanup(
  375        process_create(path(git),
  376                       [ 'rev-parse', '--short',
  377                         Commit
  378                       ],
  379                       [ stdout(pipe(Out)),
  380                         stderr(null),
  381                         process(PID),
  382                         cwd(Dir)
  383                       ]),
  384        call_cleanup(
  385            read_stream_to_codes(Out, V0, []),
  386            git_wait(PID, Out, Status)),
  387        close(Out)),
  388    Status = exit(0),
  389    atom_codes(V1, V0),
  390    normalize_space(atom(Plain), V1),
  391    (   git_is_clean(Dir)
  392    ->  Version = Plain
  393    ;   atom_concat(Plain, '-DIRTY', Version)
  394    ).
  395
  396
  397:- multifile
  398    git_version_pattern/1.  399
  400git_version_pattern('V*').
  401git_version_pattern('*').
  402
  403
  404%!  git_is_clean(+Dir) is semidet.
  405%
  406%   True if the given directory is in   a git module and this module
  407%   is clean. To us, clean only   implies that =|git diff|= produces
  408%   no output.
  409
  410git_is_clean(Dir) :-
  411    setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
  412                                      [ stdout(pipe(Out)),
  413                                        stderr(null),
  414                                        cwd(Dir)
  415                                      ]),
  416                       stream_char_count(Out, Count),
  417                       close(Out)),
  418    Count == 0.
  419
  420stream_char_count(Out, Count) :-
  421    setup_call_cleanup(open_null_stream(Null),
  422                       (   copy_stream_data(Out, Null),
  423                           character_count(Null, Count)
  424                       ),
  425                       close(Null)).
  426
  427
  428%!  git_hash(-Hash, +Options) is det.
  429%
  430%   Return the hash of the indicated object.
  431
  432git_hash(Hash, Options) :-
  433    option(commit(Commit), Options, 'HEAD'),
  434    git_process_output(['rev-parse', '--verify', Commit],
  435                       read_hash(Hash),
  436                       Options).
  437
  438read_hash(Hash, Stream) :-
  439    read_line_to_codes(Stream, Line),
  440    atom_codes(Hash, Line).
  441
  442
  443%!  git_ls_tree(-Entries, +Options) is det.
  444%
  445%   True  when  Entries  is  a  list  of  entries  in  the  the  GIT
  446%   repository, Each entry is a term:
  447%
  448%     ==
  449%     object(Mode, Type, Hash, Size, Name)
  450%     ==
  451
  452git_ls_tree(Entries, Options) :-
  453    option(commit(Commit), Options, 'HEAD'),
  454    git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
  455                       read_tree(Entries),
  456                       Options).
  457
  458read_tree(Entries, Stream) :-
  459    read_stream_to_codes(Stream, Codes),
  460    phrase(ls_tree(Entries), Codes).
  461
  462ls_tree([H|T]) -->
  463    ls_entry(H),
  464    !,
  465    ls_tree(T).
  466ls_tree([]) --> [].
  467
  468ls_entry(object(Mode, Type, Hash, Size, Name)) -->
  469    string(MS), " ",
  470    string(TS), " ",
  471    string(HS), " ",
  472    string(SS), "\t",
  473    string(NS), [0],
  474    !,
  475    { number_codes(Mode, [0'0,0'o|MS]),
  476      atom_codes(Type, TS),
  477      atom_codes(Hash, HS),
  478      (   Type == blob
  479      ->  number_codes(Size, SS)
  480      ;   Size = 0          % actually '-', but 0 sums easier
  481      ),
  482      atom_codes(Name, NS)
  483    }.
  484
  485
  486%!  git_remote_url(+Remote, -URL, +Options) is det.
  487%
  488%   URL is the remote (fetch) URL for the given Remote.
  489
  490git_remote_url(Remote, URL, Options) :-
  491    git_process_output([remote, show, Remote],
  492                       read_url("Fetch URL:", URL),
  493                       Options).
  494
  495read_url(Tag, URL, In) :-
  496    repeat,
  497        read_line_to_codes(In, Line),
  498        (   Line == end_of_file
  499        ->  !, fail
  500        ;   phrase(url_codes(Tag, Codes), Line)
  501        ->  !, atom_codes(URL, Codes)
  502        ).
  503
  504url_codes(Tag, Rest) -->
  505    { string_codes(Tag, TagCodes) },
  506    whites, string(TagCodes), whites, string(Rest).
  507
  508
  509%!  git_ls_remote(+GitURL, -Refs, +Options) is det.
  510%
  511%   Execute =|git ls-remote|= against the remote repository to fetch
  512%   references from the remote.  Options processed:
  513%
  514%     * heads(Boolean)
  515%     * tags(Boolean)
  516%     * refs(List)
  517%
  518%   For example, to find the hash of the remote =HEAD=, one can use
  519%
  520%     ==
  521%     ?- git_ls_remote('git://www.swi-prolog.org/home/pl/git/pl-devel.git',
  522%                      Refs, [refs(['HEAD'])]).
  523%     Refs = ['5d596c52aa969d88e7959f86327f5c7ff23695f3'-'HEAD'].
  524%     ==
  525%
  526%   @param Refs is a list of pairs hash-name.
  527
  528git_ls_remote(GitURL, Refs, Options) :-
  529    findall(O, ls_remote_option(Options, O), RemoteOptions),
  530    option(refs(LimitRefs), Options, []),
  531    must_be(list(atom), LimitRefs),
  532    append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
  533    git_process_output(Argv, remote_refs(Refs), Options).
  534
  535ls_remote_option(Options, '--heads') :-
  536    option(heads(true), Options).
  537ls_remote_option(Options, '--tags') :-
  538    option(tags(true), Options).
  539
  540remote_refs(Refs, Out) :-
  541    read_line_to_codes(Out, Line0),
  542    remote_refs(Line0, Out, Refs).
  543
  544remote_refs(end_of_file, _, []) :- !.
  545remote_refs(Line, Out, [Hash-Ref|Tail]) :-
  546    phrase(remote_ref(Hash,Ref), Line),
  547    read_line_to_codes(Out, Line1),
  548    remote_refs(Line1, Out, Tail).
  549
  550remote_ref(Hash, Ref) -->
  551    string_without("\t ", HashCodes),
  552    whites,
  553    string_without("\t ", RefCodes),
  554    { atom_codes(Hash, HashCodes),
  555      atom_codes(Ref, RefCodes)
  556    }.
  557
  558
  559%!  git_remote_branches(+GitURL, -Branches) is det.
  560%
  561%   Exploit git_ls_remote/3 to fetch  the   branches  from  a remote
  562%   repository without downloading it.
  563
  564git_remote_branches(GitURL, Branches) :-
  565    git_ls_remote(GitURL, Refs, [heads(true)]),
  566    findall(B, (member(_-Head, Refs),
  567                atom_concat('refs/heads/', B, Head)),
  568            Branches).
  569
  570
  571%!  git_default_branch(-BranchName, +Options) is det.
  572%
  573%   True when BranchName is the default branch of a repository.
  574
  575git_default_branch(BranchName, Options) :-
  576    git_process_output([branch],
  577                       read_default_branch(BranchName),
  578                       Options).
  579
  580read_default_branch(BranchName, In) :-
  581    repeat,
  582        read_line_to_codes(In, Line),
  583        (   Line == end_of_file
  584        ->  !, fail
  585        ;   phrase(default_branch(Codes), Line)
  586        ->  !, atom_codes(BranchName, Codes)
  587        ).
  588
  589default_branch(Rest) -->
  590    "*", whites, string(Rest).
  591
  592%!  git_branches(-Branches, +Options) is det.
  593%
  594%   True when Branches is the list of branches in the repository.
  595%   In addition to the usual options, this processes:
  596%
  597%     - contains(Commit)
  598%     Return only branches that contain Commit.
  599
  600git_branches(Branches, Options) :-
  601    (   select_option(commit(Commit), Options, GitOptions)
  602    ->  Extra = ['--contains', Commit]
  603    ;   Extra = [],
  604        GitOptions = Options
  605    ),
  606    git_process_output([branch|Extra],
  607                       read_branches(Branches),
  608                       GitOptions).
  609
  610read_branches(Branches, In) :-
  611    read_line_to_codes(In, Line),
  612    (   Line == end_of_file
  613    ->  Branches = []
  614    ;   Line = [_,_|Codes],
  615        atom_codes(H, Codes),
  616        Branches = [H|T],
  617        read_branches(T, In)
  618    ).
  619
  620
  621%!  git_tags_on_branch(+Dir, +Branch, -Tags) is det.
  622%
  623%   Tags is a list of tags in Branch on the GIT repository Dir, most
  624%   recent tag first.
  625%
  626%   @see Git tricks at http://mislav.uniqpath.com/2010/07/git-tips/
  627
  628git_tags_on_branch(Dir, Branch, Tags) :-
  629    git_process_output([ log, '--oneline', '--decorate', Branch ],
  630                       log_to_tags(Tags),
  631                       [ directory(Dir) ]).
  632
  633log_to_tags(Tags, Out) :-
  634    read_line_to_codes(Out, Line0),
  635    log_to_tags(Line0, Out, Tags, []).
  636
  637log_to_tags(end_of_file, _, Tags, Tags) :- !.
  638log_to_tags(Line, Out, Tags, Tail) :-
  639    phrase(tags_on_line(Tags, Tail1), Line),
  640    read_line_to_codes(Out, Line1),
  641    log_to_tags(Line1, Out, Tail1, Tail).
  642
  643tags_on_line(Tags, Tail) -->
  644    string_without(" ", _Hash),
  645    tags(Tags, Tail),
  646    skip_rest.
  647
  648tags(Tags, Tail) -->
  649    whites,
  650    "(",
  651    tag_list(Tags, Rest),
  652    !,
  653    tags(Rest, Tail).
  654tags(Tags, Tags) -->
  655    skip_rest.
  656
  657tag_list([H|T], Rest) -->
  658    "tag:", !, whites,
  659    string(Codes),
  660    (   ")"
  661    ->  { atom_codes(H, Codes),
  662          T = Rest
  663        }
  664    ;   ","
  665    ->  { atom_codes(H, Codes)
  666        },
  667        whites,
  668        tag_list(T, Rest)
  669    ).
  670tag_list(List, Rest) -->
  671    string(_),
  672    (   ")"
  673    ->  { List = Rest }
  674    ;   ","
  675    ->  whites,
  676        tag_list(List, Rest)
  677    ).
  678
  679skip_rest(_,_).
  680
  681
  682                 /*******************************
  683                 *        READ GIT HISTORY      *
  684                 *******************************/
  685
  686%!  git_shortlog(+Dir, -ShortLog, +Options) is det.
  687%
  688%   Fetch information like the  GitWeb   change  overview. Processed
  689%   options:
  690%
  691%       * limit(+Count)
  692%       Maximum number of commits to show (default is 10)
  693%       * revisions(+Revisions)
  694%       Git revision specification
  695%       * path(+Path)
  696%       Only show commits that affect Path.  Path is the path of
  697%       a checked out file.
  698%       * git_path(+Path)
  699%       Similar to =path=, but Path is relative to the repository.
  700%
  701%   @param ShortLog is a list of =git_log= records.
  702
  703:- record
  704    git_log(commit_hash:atom,
  705            author_name:atom,
  706            author_date_relative:atom,
  707            committer_name:atom,
  708            committer_date_relative:atom,
  709            committer_date_unix:integer,
  710            subject:atom,
  711            ref_names:list).  712
  713git_shortlog(Dir, ShortLog, Options) :-
  714    (   option(revisions(Range), Options)
  715    ->  RangeSpec = [Range]
  716    ;   option(limit(Limit), Options, 10),
  717        RangeSpec = ['-n', Limit]
  718    ),
  719    (   option(git_path(Path), Options)
  720    ->  Extra = ['--', Path]
  721    ;   option(path(Path), Options)
  722    ->  relative_file_name(Path, Dir, RelPath),
  723        Extra = ['--', RelPath]
  724    ;   Extra = []
  725    ),
  726    git_format_string(git_log, Fields, Format),
  727    append([[log, Format], RangeSpec, Extra], GitArgv),
  728    git_process_output(GitArgv,
  729                       read_git_formatted(git_log, Fields, ShortLog),
  730                       [directory(Dir)]).
  731
  732
  733read_git_formatted(Record, Fields, ShortLog, In) :-
  734    read_line_to_codes(In, Line0),
  735    read_git_formatted(Line0, In, Record, Fields, ShortLog).
  736
  737read_git_formatted(end_of_file, _, _, _, []) :- !.
  738read_git_formatted(Line, In, Record, Fields, [H|T]) :-
  739    record_from_line(Record, Fields, Line, H),
  740    read_line_to_codes(In, Line1),
  741    read_git_formatted(Line1, In, Record, Fields, T).
  742
  743record_from_line(RecordName, Fields, Line, Record) :-
  744    phrase(fields_from_line(Fields, Values), Line),
  745    Record =.. [RecordName|Values].
  746
  747fields_from_line([], []) --> [].
  748fields_from_line([F|FT], [V|VT]) -->
  749    to_nul_s(Codes),
  750    { field_to_prolog(F, Codes, V) },
  751    fields_from_line(FT, VT).
  752
  753to_nul_s([]) --> [0], !.
  754to_nul_s([H|T]) --> [H], to_nul_s(T).
  755
  756field_to_prolog(ref_names, Line, List) :-
  757    phrase(ref_names(List), Line),
  758    !.
  759field_to_prolog(committer_date_unix, Line, Stamp) :-
  760    !,
  761    number_codes(Stamp, Line).
  762field_to_prolog(_, Line, Atom) :-
  763    atom_codes(Atom, Line).
  764
  765ref_names([]) --> [].
  766ref_names(List) -->
  767    blanks, "(", ref_name_list(List), ")".
  768
  769ref_name_list([H|T]) -->
  770    string_without(",)", Codes),
  771    { atom_codes(H, Codes) },
  772    (   ",", blanks
  773    ->  ref_name_list(T)
  774    ;   {T=[]}
  775    ).
  776
  777
  778%!  git_show(+Dir, +Hash, -Commit, +Options) is det.
  779%
  780%   Fetch info from a GIT commit.  Options processed:
  781%
  782%     * diff(Diff)
  783%     GIT option on how to format diffs.  E.g. =stat=
  784%     * max_lines(Count)
  785%     Truncate the body at Count lines.
  786%
  787%   @param  Commit is a term git_commit(...)-Body.  Body is currently
  788%           a list of lines, each line represented as a list of
  789%           codes.
  790
  791:- record
  792    git_commit(tree_hash:atom,
  793               parent_hashes:list,
  794               author_name:atom,
  795               author_date:atom,
  796               committer_name:atom,
  797               committer_date:atom,
  798               subject:atom).  799
  800git_show(Dir, Hash, Commit, Options) :-
  801    git_format_string(git_commit, Fields, Format),
  802    option(diff(Diff), Options, patch),
  803    diff_arg(Diff, DiffArg),
  804    git_process_output([ show, DiffArg, Hash, Format ],
  805                       read_commit(Fields, Commit, Options),
  806                       [directory(Dir)]).
  807
  808diff_arg(patch, '-p').
  809diff_arg(stat, '--stat').
  810
  811read_commit(Fields, Data-Body, Options, In) :-
  812    read_line_to_codes(In, Line1),
  813    record_from_line(git_commit, Fields, Line1, Data),
  814    read_line_to_codes(In, Line2),
  815    (   Line2 == []
  816    ->  option(max_lines(Max), Options, -1),
  817        read_n_lines(In, Max, Body)
  818    ;   Line2 == end_of_file
  819    ->  Body = []
  820    ).
  821
  822read_n_lines(In, Max, Lines) :-
  823    read_line_to_codes(In, Line1),
  824    read_n_lines(Line1, Max, In, Lines).
  825
  826read_n_lines(end_of_file, _, _, []) :- !.
  827read_n_lines(_, 0, In, []) :-
  828    !,
  829    setup_call_cleanup(open_null_stream(Out),
  830                       copy_stream_data(In, Out),
  831                       close(Out)).
  832read_n_lines(Line, Max0, In, [Line|More]) :-
  833    read_line_to_codes(In, Line2),
  834    Max is Max0-1,
  835    read_n_lines(Line2, Max, In, More).
  836
  837
  838%!  git_format_string(:Record, -FieldNames, -Format)
  839%
  840%   If Record is a record with  fields   whose  names  match the GIT
  841%   format field-names, Format is a  git =|--format=|= argument with
  842%   the appropriate format-specifiers,  terminated   by  %x00, which
  843%   causes the actual field to be 0-terminated.
  844
  845:- meta_predicate
  846    git_format_string(:, -, -).  847
  848git_format_string(M:RecordName, Fields, Format) :-
  849    current_record(RecordName, M:Term),
  850    findall(F, record_field(Term, F), Fields),
  851    maplist(git_field_format, Fields, Formats),
  852    atomic_list_concat(['--format='|Formats], Format).
  853
  854record_field(Term, Name) :-
  855    arg(_, Term, Field),
  856    field_name(Field, Name).
  857
  858field_name(Name:_Type=_Default, Name) :- !.
  859field_name(Name:_Type, Name) :- !.
  860field_name(Name=_Default, Name) :- !.
  861field_name(Name, Name).
  862
  863git_field_format(Field, Fmt) :-
  864    (   git_format(NoPercent, Field)
  865    ->  atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
  866    ;   existence_error(git_format, Field)
  867    ).
  868
  869git_format('H', commit_hash).
  870git_format('h', abbreviated_commit_hash).
  871git_format('T', tree_hash).
  872git_format('t', abbreviated_tree_hash).
  873git_format('P', parent_hashes).
  874git_format('p', abbreviated_parent_hashes).
  875
  876git_format('an', author_name).
  877git_format('aN', author_name_mailcap).
  878git_format('ae', author_email).
  879git_format('aE', author_email_mailcap).
  880git_format('ad', author_date).
  881git_format('aD', author_date_rfc2822).
  882git_format('ar', author_date_relative).
  883git_format('at', author_date_unix).
  884git_format('ai', author_date_iso8601).
  885
  886git_format('cn', committer_name).
  887git_format('cN', committer_name_mailcap).
  888git_format('ce', committer_email).
  889git_format('cE', committer_email_mailcap).
  890git_format('cd', committer_date).
  891git_format('cD', committer_date_rfc2822).
  892git_format('cr', committer_date_relative).
  893git_format('ct', committer_date_unix).
  894git_format('ci', committer_date_iso8601).
  895
  896git_format('d', ref_names).             % git log?
  897git_format('e', encoding).              % git log?
  898
  899git_format('s', subject).
  900git_format('f', subject_sanitized).
  901git_format('b', body).
  902git_format('N', notes).
  903
  904git_format('gD', reflog_selector).
  905git_format('gd', shortened_reflog_selector).
  906git_format('gs', reflog_subject).
  907
  908
  909                 /*******************************
  910                 *            MESSAGES          *
  911                 *******************************/
  912
  913:- multifile
  914    prolog:message//1.  915
  916prolog:message(git(output(Codes))) -->
  917    { split_lines(Codes, Lines) },
  918    git_lines(Lines).
  919
  920git_lines([]) --> [].
  921git_lines([H|T]) -->
  922    [ '~s'-[H] ],
  923    (   {T==[]}
  924    ->  []
  925    ;   [nl], git_lines(T)
  926    ).
  927
  928split_lines([], []) :- !.
  929split_lines(All, [Line1|More]) :-
  930    append(Line1, [0'\n|Rest], All),
  931    !,
  932    split_lines(Rest, More).
  933split_lines(Line, [Line])