git-cvsserver.perlon commit Merge branch 'jc/numstat' (f5c589f)
   1#!/usr/bin/perl
   2
   3####
   4#### This application is a CVS emulation layer for git.
   5#### It is intended for clients to connect over SSH.
   6#### See the documentation for more details.
   7####
   8#### Copyright The Open University UK - 2006.
   9####
  10#### Authors: Martyn Smith    <martyn@catalyst.net.nz>
  11####          Martin Langhoff <martin@catalyst.net.nz>
  12####
  13####
  14#### Released under the GNU Public License, version 2.
  15####
  16####
  17
  18use strict;
  19use warnings;
  20use bytes;
  21
  22use Fcntl;
  23use File::Temp qw/tempdir tempfile/;
  24use File::Basename;
  25
  26my $log = GITCVS::log->new();
  27my $cfg;
  28
  29my $DATE_LIST = {
  30    Jan => "01",
  31    Feb => "02",
  32    Mar => "03",
  33    Apr => "04",
  34    May => "05",
  35    Jun => "06",
  36    Jul => "07",
  37    Aug => "08",
  38    Sep => "09",
  39    Oct => "10",
  40    Nov => "11",
  41    Dec => "12",
  42};
  43
  44# Enable autoflush for STDOUT (otherwise the whole thing falls apart)
  45$| = 1;
  46
  47#### Definition and mappings of functions ####
  48
  49my $methods = {
  50    'Root'            => \&req_Root,
  51    'Valid-responses' => \&req_Validresponses,
  52    'valid-requests'  => \&req_validrequests,
  53    'Directory'       => \&req_Directory,
  54    'Entry'           => \&req_Entry,
  55    'Modified'        => \&req_Modified,
  56    'Unchanged'       => \&req_Unchanged,
  57    'Questionable'    => \&req_Questionable,
  58    'Argument'        => \&req_Argument,
  59    'Argumentx'       => \&req_Argument,
  60    'expand-modules'  => \&req_expandmodules,
  61    'add'             => \&req_add,
  62    'remove'          => \&req_remove,
  63    'co'              => \&req_co,
  64    'update'          => \&req_update,
  65    'ci'              => \&req_ci,
  66    'diff'            => \&req_diff,
  67    'log'             => \&req_log,
  68    'rlog'            => \&req_log,
  69    'tag'             => \&req_CATCHALL,
  70    'status'          => \&req_status,
  71    'admin'           => \&req_CATCHALL,
  72    'history'         => \&req_CATCHALL,
  73    'watchers'        => \&req_CATCHALL,
  74    'editors'         => \&req_CATCHALL,
  75    'annotate'        => \&req_annotate,
  76    'Global_option'   => \&req_Globaloption,
  77    #'annotate'        => \&req_CATCHALL,
  78};
  79
  80##############################################
  81
  82
  83# $state holds all the bits of information the clients sends us that could
  84# potentially be useful when it comes to actually _doing_ something.
  85my $state = { prependdir => '' };
  86$log->info("--------------- STARTING -----------------");
  87
  88my $TEMP_DIR = tempdir( CLEANUP => 1 );
  89$log->debug("Temporary directory is '$TEMP_DIR'");
  90
  91# if we are called with a pserver argument,
  92# deal with the authentication cat before entering the
  93# main loop
  94if (@ARGV && $ARGV[0] eq 'pserver') {
  95    my $line = <STDIN>; chomp $line;
  96    unless( $line eq 'BEGIN AUTH REQUEST') {
  97       die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
  98    }
  99    $line = <STDIN>; chomp $line;
 100    req_Root('root', $line) # reuse Root
 101       or die "E Invalid root $line \n";
 102    $line = <STDIN>; chomp $line;
 103    unless ($line eq 'anonymous') {
 104       print "E Only anonymous user allowed via pserver\n";
 105       print "I HATE YOU\n";
 106    }
 107    $line = <STDIN>; chomp $line;    # validate the password?
 108    $line = <STDIN>; chomp $line;
 109    unless ($line eq 'END AUTH REQUEST') {
 110       die "E Do not understand $line -- expecting END AUTH REQUEST\n";
 111    }
 112    print "I LOVE YOU\n";
 113    # and now back to our regular programme...
 114}
 115
 116# Keep going until the client closes the connection
 117while (<STDIN>)
 118{
 119    chomp;
 120
 121    # Check to see if we've seen this method, and call appropriate function.
 122    if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
 123    {
 124        # use the $methods hash to call the appropriate sub for this command
 125        #$log->info("Method : $1");
 126        &{$methods->{$1}}($1,$2);
 127    } else {
 128        # log fatal because we don't understand this function. If this happens
 129        # we're fairly screwed because we don't know if the client is expecting
 130        # a response. If it is, the client will hang, we'll hang, and the whole
 131        # thing will be custard.
 132        $log->fatal("Don't understand command $_\n");
 133        die("Unknown command $_");
 134    }
 135}
 136
 137$log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
 138$log->info("--------------- FINISH -----------------");
 139
 140# Magic catchall method.
 141#    This is the method that will handle all commands we haven't yet
 142#    implemented. It simply sends a warning to the log file indicating a
 143#    command that hasn't been implemented has been invoked.
 144sub req_CATCHALL
 145{
 146    my ( $cmd, $data ) = @_;
 147    $log->warn("Unhandled command : req_$cmd : $data");
 148}
 149
 150
 151# Root pathname \n
 152#     Response expected: no. Tell the server which CVSROOT to use. Note that
 153#     pathname is a local directory and not a fully qualified CVSROOT variable.
 154#     pathname must already exist; if creating a new root, use the init
 155#     request, not Root. pathname does not include the hostname of the server,
 156#     how to access the server, etc.; by the time the CVS protocol is in use,
 157#     connection, authentication, etc., are already taken care of. The Root
 158#     request must be sent only once, and it must be sent before any requests
 159#     other than Valid-responses, valid-requests, UseUnchanged, Set or init.
 160sub req_Root
 161{
 162    my ( $cmd, $data ) = @_;
 163    $log->debug("req_Root : $data");
 164
 165    $state->{CVSROOT} = $data;
 166
 167    $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 168    unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
 169       print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
 170        print "E \n";
 171        print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
 172       return 0;
 173    }
 174
 175    my @gitvars = `git-repo-config -l`;
 176    if ($?) {
 177       print "E problems executing git-repo-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
 178        print "E \n";
 179        print "error 1 - problem executing git-repo-config\n";
 180       return 0;
 181    }
 182    foreach my $line ( @gitvars )
 183    {
 184        next unless ( $line =~ /^(.*?)\.(.*?)=(.*)$/ );
 185        $cfg->{$1}{$2} = $3;
 186    }
 187
 188    unless ( defined ( $cfg->{gitcvs}{enabled} ) and $cfg->{gitcvs}{enabled} =~ /^\s*(1|true|yes)\s*$/i )
 189    {
 190        print "E GITCVS emulation needs to be enabled on this repo\n";
 191        print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
 192        print "E \n";
 193        print "error 1 GITCVS emulation disabled\n";
 194        return 0;
 195    }
 196
 197    if ( defined ( $cfg->{gitcvs}{logfile} ) )
 198    {
 199        $log->setfile($cfg->{gitcvs}{logfile});
 200    } else {
 201        $log->nofile();
 202    }
 203
 204    return 1;
 205}
 206
 207# Global_option option \n
 208#     Response expected: no. Transmit one of the global options `-q', `-Q',
 209#     `-l', `-t', `-r', or `-n'. option must be one of those strings, no
 210#     variations (such as combining of options) are allowed. For graceful
 211#     handling of valid-requests, it is probably better to make new global
 212#     options separate requests, rather than trying to add them to this
 213#     request.
 214sub req_Globaloption
 215{
 216    my ( $cmd, $data ) = @_;
 217    $log->debug("req_Globaloption : $data");
 218    $state->{globaloptions}{$data} = 1;
 219}
 220
 221# Valid-responses request-list \n
 222#     Response expected: no. Tell the server what responses the client will
 223#     accept. request-list is a space separated list of tokens.
 224sub req_Validresponses
 225{
 226    my ( $cmd, $data ) = @_;
 227    $log->debug("req_Validresponses : $data");
 228
 229    # TODO : re-enable this, currently it's not particularly useful
 230    #$state->{validresponses} = [ split /\s+/, $data ];
 231}
 232
 233# valid-requests \n
 234#     Response expected: yes. Ask the server to send back a Valid-requests
 235#     response.
 236sub req_validrequests
 237{
 238    my ( $cmd, $data ) = @_;
 239
 240    $log->debug("req_validrequests");
 241
 242    $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
 243    $log->debug("SEND : ok");
 244
 245    print "Valid-requests " . join(" ",keys %$methods) . "\n";
 246    print "ok\n";
 247}
 248
 249# Directory local-directory \n
 250#     Additional data: repository \n. Response expected: no. Tell the server
 251#     what directory to use. The repository should be a directory name from a
 252#     previous server response. Note that this both gives a default for Entry
 253#     and Modified and also for ci and the other commands; normal usage is to
 254#     send Directory for each directory in which there will be an Entry or
 255#     Modified, and then a final Directory for the original directory, then the
 256#     command. The local-directory is relative to the top level at which the
 257#     command is occurring (i.e. the last Directory which is sent before the
 258#     command); to indicate that top level, `.' should be sent for
 259#     local-directory.
 260sub req_Directory
 261{
 262    my ( $cmd, $data ) = @_;
 263
 264    my $repository = <STDIN>;
 265    chomp $repository;
 266
 267
 268    $state->{localdir} = $data;
 269    $state->{repository} = $repository;
 270    $state->{path} = $repository;
 271    $state->{path} =~ s/^$state->{CVSROOT}\///;
 272    $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
 273    $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
 274
 275    $state->{directory} = $state->{localdir};
 276    $state->{directory} = "" if ( $state->{directory} eq "." );
 277    $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
 278
 279    if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
 280    {
 281        $log->info("Setting prepend to '$state->{path}'");
 282        $state->{prependdir} = $state->{path};
 283        foreach my $entry ( keys %{$state->{entries}} )
 284        {
 285            $state->{entries}{$state->{prependdir} . $entry} = $state->{entries}{$entry};
 286            delete $state->{entries}{$entry};
 287        }
 288    }
 289
 290    if ( defined ( $state->{prependdir} ) )
 291    {
 292        $log->debug("Prepending '$state->{prependdir}' to state|directory");
 293        $state->{directory} = $state->{prependdir} . $state->{directory}
 294    }
 295    $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
 296}
 297
 298# Entry entry-line \n
 299#     Response expected: no. Tell the server what version of a file is on the
 300#     local machine. The name in entry-line is a name relative to the directory
 301#     most recently specified with Directory. If the user is operating on only
 302#     some files in a directory, Entry requests for only those files need be
 303#     included. If an Entry request is sent without Modified, Is-modified, or
 304#     Unchanged, it means the file is lost (does not exist in the working
 305#     directory). If both Entry and one of Modified, Is-modified, or Unchanged
 306#     are sent for the same file, Entry must be sent first. For a given file,
 307#     one can send Modified, Is-modified, or Unchanged, but not more than one
 308#     of these three.
 309sub req_Entry
 310{
 311    my ( $cmd, $data ) = @_;
 312
 313    #$log->debug("req_Entry : $data");
 314
 315    my @data = split(/\//, $data);
 316
 317    $state->{entries}{$state->{directory}.$data[1]} = {
 318        revision    => $data[2],
 319        conflict    => $data[3],
 320        options     => $data[4],
 321        tag_or_date => $data[5],
 322    };
 323
 324    $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
 325}
 326
 327# Questionable filename \n
 328#     Response expected: no. Additional data: no. Tell the server to check
 329#     whether filename should be ignored, and if not, next time the server
 330#     sends responses, send (in a M response) `?' followed by the directory and
 331#     filename. filename must not contain `/'; it needs to be a file in the
 332#     directory named by the most recent Directory request.
 333sub req_Questionable
 334{
 335    my ( $cmd, $data ) = @_;
 336
 337    $log->debug("req_Questionable : $data");
 338    $state->{entries}{$state->{directory}.$data}{questionable} = 1;
 339}
 340
 341# add \n
 342#     Response expected: yes. Add a file or directory. This uses any previous
 343#     Argument, Directory, Entry, or Modified requests, if they have been sent.
 344#     The last Directory sent specifies the working directory at the time of
 345#     the operation. To add a directory, send the directory to be added using
 346#     Directory and Argument requests.
 347sub req_add
 348{
 349    my ( $cmd, $data ) = @_;
 350
 351    argsplit("add");
 352
 353    my $addcount = 0;
 354
 355    foreach my $filename ( @{$state->{args}} )
 356    {
 357        $filename = filecleanup($filename);
 358
 359        unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
 360        {
 361            print "E cvs add: nothing known about `$filename'\n";
 362            next;
 363        }
 364        # TODO : check we're not squashing an already existing file
 365        if ( defined ( $state->{entries}{$filename}{revision} ) )
 366        {
 367            print "E cvs add: `$filename' has already been entered\n";
 368            next;
 369        }
 370
 371        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 372
 373        print "E cvs add: scheduling file `$filename' for addition\n";
 374
 375        print "Checked-in $dirpart\n";
 376        print "$filename\n";
 377        print "/$filepart/0///\n";
 378
 379        $addcount++;
 380    }
 381
 382    if ( $addcount == 1 )
 383    {
 384        print "E cvs add: use `cvs commit' to add this file permanently\n";
 385    }
 386    elsif ( $addcount > 1 )
 387    {
 388        print "E cvs add: use `cvs commit' to add these files permanently\n";
 389    }
 390
 391    print "ok\n";
 392}
 393
 394# remove \n
 395#     Response expected: yes. Remove a file. This uses any previous Argument,
 396#     Directory, Entry, or Modified requests, if they have been sent. The last
 397#     Directory sent specifies the working directory at the time of the
 398#     operation. Note that this request does not actually do anything to the
 399#     repository; the only effect of a successful remove request is to supply
 400#     the client with a new entries line containing `-' to indicate a removed
 401#     file. In fact, the client probably could perform this operation without
 402#     contacting the server, although using remove may cause the server to
 403#     perform a few more checks. The client sends a subsequent ci request to
 404#     actually record the removal in the repository.
 405sub req_remove
 406{
 407    my ( $cmd, $data ) = @_;
 408
 409    argsplit("remove");
 410
 411    # Grab a handle to the SQLite db and do any necessary updates
 412    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 413    $updater->update();
 414
 415    #$log->debug("add state : " . Dumper($state));
 416
 417    my $rmcount = 0;
 418
 419    foreach my $filename ( @{$state->{args}} )
 420    {
 421        $filename = filecleanup($filename);
 422
 423        if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
 424        {
 425            print "E cvs remove: file `$filename' still in working directory\n";
 426            next;
 427        }
 428
 429        my $meta = $updater->getmeta($filename);
 430        my $wrev = revparse($filename);
 431
 432        unless ( defined ( $wrev ) )
 433        {
 434            print "E cvs remove: nothing known about `$filename'\n";
 435            next;
 436        }
 437
 438        if ( defined($wrev) and $wrev < 0 )
 439        {
 440            print "E cvs remove: file `$filename' already scheduled for removal\n";
 441            next;
 442        }
 443
 444        unless ( $wrev == $meta->{revision} )
 445        {
 446            # TODO : not sure if the format of this message is quite correct.
 447            print "E cvs remove: Up to date check failed for `$filename'\n";
 448            next;
 449        }
 450
 451
 452        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 453
 454        print "E cvs remove: scheduling `$filename' for removal\n";
 455
 456        print "Checked-in $dirpart\n";
 457        print "$filename\n";
 458        print "/$filepart/-1.$wrev///\n";
 459
 460        $rmcount++;
 461    }
 462
 463    if ( $rmcount == 1 )
 464    {
 465        print "E cvs remove: use `cvs commit' to remove this file permanently\n";
 466    }
 467    elsif ( $rmcount > 1 )
 468    {
 469        print "E cvs remove: use `cvs commit' to remove these files permanently\n";
 470    }
 471
 472    print "ok\n";
 473}
 474
 475# Modified filename \n
 476#     Response expected: no. Additional data: mode, \n, file transmission. Send
 477#     the server a copy of one locally modified file. filename is a file within
 478#     the most recent directory sent with Directory; it must not contain `/'.
 479#     If the user is operating on only some files in a directory, only those
 480#     files need to be included. This can also be sent without Entry, if there
 481#     is no entry for the file.
 482sub req_Modified
 483{
 484    my ( $cmd, $data ) = @_;
 485
 486    my $mode = <STDIN>;
 487    chomp $mode;
 488    my $size = <STDIN>;
 489    chomp $size;
 490
 491    # Grab config information
 492    my $blocksize = 8192;
 493    my $bytesleft = $size;
 494    my $tmp;
 495
 496    # Get a filehandle/name to write it to
 497    my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
 498
 499    # Loop over file data writing out to temporary file.
 500    while ( $bytesleft )
 501    {
 502        $blocksize = $bytesleft if ( $bytesleft < $blocksize );
 503        read STDIN, $tmp, $blocksize;
 504        print $fh $tmp;
 505        $bytesleft -= $blocksize;
 506    }
 507
 508    close $fh;
 509
 510    # Ensure we have something sensible for the file mode
 511    if ( $mode =~ /u=(\w+)/ )
 512    {
 513        $mode = $1;
 514    } else {
 515        $mode = "rw";
 516    }
 517
 518    # Save the file data in $state
 519    $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
 520    $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
 521    $state->{entries}{$state->{directory}.$data}{modified_hash} = `git-hash-object $filename`;
 522    $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
 523
 524    #$log->debug("req_Modified : file=$data mode=$mode size=$size");
 525}
 526
 527# Unchanged filename \n
 528#     Response expected: no. Tell the server that filename has not been
 529#     modified in the checked out directory. The filename is a file within the
 530#     most recent directory sent with Directory; it must not contain `/'.
 531sub req_Unchanged
 532{
 533    my ( $cmd, $data ) = @_;
 534
 535    $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
 536
 537    #$log->debug("req_Unchanged : $data");
 538}
 539
 540# Argument text \n
 541#     Response expected: no. Save argument for use in a subsequent command.
 542#     Arguments accumulate until an argument-using command is given, at which
 543#     point they are forgotten.
 544# Argumentx text \n
 545#     Response expected: no. Append \n followed by text to the current argument
 546#     being saved.
 547sub req_Argument
 548{
 549    my ( $cmd, $data ) = @_;
 550
 551    # Argumentx means: append to last Argument (with a newline in front)
 552
 553    $log->debug("$cmd : $data");
 554
 555    if ( $cmd eq 'Argumentx') {
 556        ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
 557    } else {
 558        push @{$state->{arguments}}, $data;
 559    }
 560}
 561
 562# expand-modules \n
 563#     Response expected: yes. Expand the modules which are specified in the
 564#     arguments. Returns the data in Module-expansion responses. Note that the
 565#     server can assume that this is checkout or export, not rtag or rdiff; the
 566#     latter do not access the working directory and thus have no need to
 567#     expand modules on the client side. Expand may not be the best word for
 568#     what this request does. It does not necessarily tell you all the files
 569#     contained in a module, for example. Basically it is a way of telling you
 570#     which working directories the server needs to know about in order to
 571#     handle a checkout of the specified modules. For example, suppose that the
 572#     server has a module defined by
 573#   aliasmodule -a 1dir
 574#     That is, one can check out aliasmodule and it will take 1dir in the
 575#     repository and check it out to 1dir in the working directory. Now suppose
 576#     the client already has this module checked out and is planning on using
 577#     the co request to update it. Without using expand-modules, the client
 578#     would have two bad choices: it could either send information about all
 579#     working directories under the current directory, which could be
 580#     unnecessarily slow, or it could be ignorant of the fact that aliasmodule
 581#     stands for 1dir, and neglect to send information for 1dir, which would
 582#     lead to incorrect operation. With expand-modules, the client would first
 583#     ask for the module to be expanded:
 584sub req_expandmodules
 585{
 586    my ( $cmd, $data ) = @_;
 587
 588    argsplit();
 589
 590    $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
 591
 592    unless ( ref $state->{arguments} eq "ARRAY" )
 593    {
 594        print "ok\n";
 595        return;
 596    }
 597
 598    foreach my $module ( @{$state->{arguments}} )
 599    {
 600        $log->debug("SEND : Module-expansion $module");
 601        print "Module-expansion $module\n";
 602    }
 603
 604    print "ok\n";
 605    statecleanup();
 606}
 607
 608# co \n
 609#     Response expected: yes. Get files from the repository. This uses any
 610#     previous Argument, Directory, Entry, or Modified requests, if they have
 611#     been sent. Arguments to this command are module names; the client cannot
 612#     know what directories they correspond to except by (1) just sending the
 613#     co request, and then seeing what directory names the server sends back in
 614#     its responses, and (2) the expand-modules request.
 615sub req_co
 616{
 617    my ( $cmd, $data ) = @_;
 618
 619    argsplit("co");
 620
 621    my $module = $state->{args}[0];
 622    my $checkout_path = $module;
 623
 624    # use the user specified directory if we're given it
 625    $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
 626
 627    $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
 628
 629    $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
 630
 631    $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 632
 633    # Grab a handle to the SQLite db and do any necessary updates
 634    my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
 635    $updater->update();
 636
 637    $checkout_path =~ s|/$||; # get rid of trailing slashes
 638
 639    # Eclipse seems to need the Clear-sticky command
 640    # to prepare the 'Entries' file for the new directory.
 641    print "Clear-sticky $checkout_path/\n";
 642    print $state->{CVSROOT} . "/$module/\n";
 643    print "Clear-static-directory $checkout_path/\n";
 644    print $state->{CVSROOT} . "/$module/\n";
 645    print "Clear-sticky $checkout_path/\n"; # yes, twice
 646    print $state->{CVSROOT} . "/$module/\n";
 647    print "Template $checkout_path/\n";
 648    print $state->{CVSROOT} . "/$module/\n";
 649    print "0\n";
 650
 651    # instruct the client that we're checking out to $checkout_path
 652    print "E cvs checkout: Updating $checkout_path\n";
 653
 654    my %seendirs = ();
 655    my $lastdir ='';
 656
 657    # recursive
 658    sub prepdir {
 659       my ($dir, $repodir, $remotedir, $seendirs) = @_;
 660       my $parent = dirname($dir);
 661       $dir       =~ s|/+$||;
 662       $repodir   =~ s|/+$||;
 663       $remotedir =~ s|/+$||;
 664       $parent    =~ s|/+$||;
 665       $log->debug("announcedir $dir, $repodir, $remotedir" );
 666
 667       if ($parent eq '.' || $parent eq './') {
 668           $parent = '';
 669       }
 670       # recurse to announce unseen parents first
 671       if (length($parent) && !exists($seendirs->{$parent})) {
 672           prepdir($parent, $repodir, $remotedir, $seendirs);
 673       }
 674       # Announce that we are going to modify at the parent level
 675       if ($parent) {
 676           print "E cvs checkout: Updating $remotedir/$parent\n";
 677       } else {
 678           print "E cvs checkout: Updating $remotedir\n";
 679       }
 680       print "Clear-sticky $remotedir/$parent/\n";
 681       print "$repodir/$parent/\n";
 682
 683       print "Clear-static-directory $remotedir/$dir/\n";
 684       print "$repodir/$dir/\n";
 685       print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
 686       print "$repodir/$parent/\n";
 687       print "Template $remotedir/$dir/\n";
 688       print "$repodir/$dir/\n";
 689       print "0\n";
 690
 691       $seendirs->{$dir} = 1;
 692    }
 693
 694    foreach my $git ( @{$updater->gethead} )
 695    {
 696        # Don't want to check out deleted files
 697        next if ( $git->{filehash} eq "deleted" );
 698
 699        ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
 700
 701       if (length($git->{dir}) && $git->{dir} ne './'
 702           && $git->{dir} ne $lastdir ) {
 703           unless (exists($seendirs{$git->{dir}})) {
 704               prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
 705                       $checkout_path, \%seendirs);
 706               $lastdir = $git->{dir};
 707               $seendirs{$git->{dir}} = 1;
 708           }
 709           print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
 710       }
 711
 712        # modification time of this file
 713        print "Mod-time $git->{modified}\n";
 714
 715        # print some information to the client
 716        if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
 717        {
 718            print "M U $checkout_path/$git->{dir}$git->{name}\n";
 719        } else {
 720            print "M U $checkout_path/$git->{name}\n";
 721        }
 722
 723       # instruct client we're sending a file to put in this path
 724       print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
 725
 726       print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
 727
 728        # this is an "entries" line
 729        print "/$git->{name}/1.$git->{revision}///\n";
 730        # permissions
 731        print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
 732
 733        # transmit file
 734        transmitfile($git->{filehash});
 735    }
 736
 737    print "ok\n";
 738
 739    statecleanup();
 740}
 741
 742# update \n
 743#     Response expected: yes. Actually do a cvs update command. This uses any
 744#     previous Argument, Directory, Entry, or Modified requests, if they have
 745#     been sent. The last Directory sent specifies the working directory at the
 746#     time of the operation. The -I option is not used--files which the client
 747#     can decide whether to ignore are not mentioned and the client sends the
 748#     Questionable request for others.
 749sub req_update
 750{
 751    my ( $cmd, $data ) = @_;
 752
 753    $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
 754
 755    argsplit("update");
 756
 757    #
 758    # It may just be a client exploring the available heads/modules
 759    # in that case, list them as top level directories and leave it
 760    # at that. Eclipse uses this technique to offer you a list of
 761    # projects (heads in this case) to checkout.
 762    #
 763    if ($state->{module} eq '') {
 764        print "E cvs update: Updating .\n";
 765        opendir HEADS, $state->{CVSROOT} . '/refs/heads';
 766        while (my $head = readdir(HEADS)) {
 767            if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
 768                print "E cvs update: New directory `$head'\n";
 769            }
 770        }
 771        closedir HEADS;
 772        print "ok\n";
 773        return 1;
 774    }
 775
 776
 777    # Grab a handle to the SQLite db and do any necessary updates
 778    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 779
 780    $updater->update();
 781
 782    argsfromdir($updater);
 783
 784    #$log->debug("update state : " . Dumper($state));
 785
 786    # foreach file specified on the command line ...
 787    foreach my $filename ( @{$state->{args}} )
 788    {
 789        $filename = filecleanup($filename);
 790
 791        $log->debug("Processing file $filename");
 792
 793        # if we have a -C we should pretend we never saw modified stuff
 794        if ( exists ( $state->{opt}{C} ) )
 795        {
 796            delete $state->{entries}{$filename}{modified_hash};
 797            delete $state->{entries}{$filename}{modified_filename};
 798            $state->{entries}{$filename}{unchanged} = 1;
 799        }
 800
 801        my $meta;
 802        if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
 803        {
 804            $meta = $updater->getmeta($filename, $1);
 805        } else {
 806            $meta = $updater->getmeta($filename);
 807        }
 808
 809        if ( ! defined $meta )
 810        {
 811            $meta = {
 812                name => $filename,
 813                revision => 0,
 814                filehash => 'added'
 815            };
 816        }
 817
 818        my $oldmeta = $meta;
 819
 820        my $wrev = revparse($filename);
 821
 822        # If the working copy is an old revision, lets get that version too for comparison.
 823        if ( defined($wrev) and $wrev != $meta->{revision} )
 824        {
 825            $oldmeta = $updater->getmeta($filename, $wrev);
 826        }
 827
 828        #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
 829
 830        # Files are up to date if the working copy and repo copy have the same revision,
 831        # and the working copy is unmodified _and_ the user hasn't specified -C
 832        next if ( defined ( $wrev )
 833                  and defined($meta->{revision})
 834                  and $wrev == $meta->{revision}
 835                  and $state->{entries}{$filename}{unchanged}
 836                  and not exists ( $state->{opt}{C} ) );
 837
 838        # If the working copy and repo copy have the same revision,
 839        # but the working copy is modified, tell the client it's modified
 840        if ( defined ( $wrev )
 841             and defined($meta->{revision})
 842             and $wrev == $meta->{revision}
 843             and not exists ( $state->{opt}{C} ) )
 844        {
 845            $log->info("Tell the client the file is modified");
 846            print "MT text M \n";
 847            print "MT fname $filename\n";
 848            print "MT newline\n";
 849            next;
 850        }
 851
 852        if ( $meta->{filehash} eq "deleted" )
 853        {
 854            my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 855
 856            $log->info("Removing '$filename' from working copy (no longer in the repo)");
 857
 858            print "E cvs update: `$filename' is no longer in the repository\n";
 859            # Don't want to actually _DO_ the update if -n specified
 860            unless ( $state->{globaloptions}{-n} ) {
 861                print "Removed $dirpart\n";
 862                print "$filepart\n";
 863            }
 864        }
 865        elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
 866                or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
 867                or $meta->{filehash} eq 'added' )
 868        {
 869            # normal update, just send the new revision (either U=Update,
 870            # or A=Add, or R=Remove)
 871            if ( defined($wrev) && $wrev < 0 )
 872            {
 873                $log->info("Tell the client the file is scheduled for removal");
 874                print "MT text R \n";
 875                print "MT fname $filename\n";
 876                print "MT newline\n";
 877                next;
 878            }
 879            elsif ( !defined($wrev) || $wrev == 0 )
 880            {
 881                $log->info("Tell the client the file will be added");
 882                print "MT text A \n";
 883                print "MT fname $filename\n";
 884                print "MT newline\n";
 885                next;
 886
 887            }
 888            else {
 889                $log->info("Updating '$filename' $wrev");
 890                print "MT +updated\n";
 891                print "MT text U \n";
 892                print "MT fname $filename\n";
 893                print "MT newline\n";
 894                print "MT -updated\n";
 895            }
 896
 897            my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 898
 899            # Don't want to actually _DO_ the update if -n specified
 900            unless ( $state->{globaloptions}{-n} )
 901            {
 902                if ( defined ( $wrev ) )
 903                {
 904                    # instruct client we're sending a file to put in this path as a replacement
 905                    print "Update-existing $dirpart\n";
 906                    $log->debug("Updating existing file 'Update-existing $dirpart'");
 907                } else {
 908                    # instruct client we're sending a file to put in this path as a new file
 909                    print "Clear-static-directory $dirpart\n";
 910                    print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
 911                    print "Clear-sticky $dirpart\n";
 912                    print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
 913
 914                    $log->debug("Creating new file 'Created $dirpart'");
 915                    print "Created $dirpart\n";
 916                }
 917                print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 918
 919                # this is an "entries" line
 920                $log->debug("/$filepart/1.$meta->{revision}///");
 921                print "/$filepart/1.$meta->{revision}///\n";
 922
 923                # permissions
 924                $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 925                print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 926
 927                # transmit file
 928                transmitfile($meta->{filehash});
 929            }
 930        } else {
 931            $log->info("Updating '$filename'");
 932            my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
 933
 934            my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
 935
 936            chdir $dir;
 937            my $file_local = $filepart . ".mine";
 938            system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
 939            my $file_old = $filepart . "." . $oldmeta->{revision};
 940            transmitfile($oldmeta->{filehash}, $file_old);
 941            my $file_new = $filepart . "." . $meta->{revision};
 942            transmitfile($meta->{filehash}, $file_new);
 943
 944            # we need to merge with the local changes ( M=successful merge, C=conflict merge )
 945            $log->info("Merging $file_local, $file_old, $file_new");
 946
 947            $log->debug("Temporary directory for merge is $dir");
 948
 949            my $return = system("git merge-file", $file_local, $file_old, $file_new);
 950            $return >>= 8;
 951
 952            if ( $return == 0 )
 953            {
 954                $log->info("Merged successfully");
 955                print "M M $filename\n";
 956                $log->debug("Update-existing $dirpart");
 957
 958                # Don't want to actually _DO_ the update if -n specified
 959                unless ( $state->{globaloptions}{-n} )
 960                {
 961                    print "Update-existing $dirpart\n";
 962                    $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
 963                    print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 964                    $log->debug("/$filepart/1.$meta->{revision}///");
 965                    print "/$filepart/1.$meta->{revision}///\n";
 966                }
 967            }
 968            elsif ( $return == 1 )
 969            {
 970                $log->info("Merged with conflicts");
 971                print "M C $filename\n";
 972
 973                # Don't want to actually _DO_ the update if -n specified
 974                unless ( $state->{globaloptions}{-n} )
 975                {
 976                    print "Update-existing $dirpart\n";
 977                    print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 978                    print "/$filepart/1.$meta->{revision}/+//\n";
 979                }
 980            }
 981            else
 982            {
 983                $log->warn("Merge failed");
 984                next;
 985            }
 986
 987            # Don't want to actually _DO_ the update if -n specified
 988            unless ( $state->{globaloptions}{-n} )
 989            {
 990                # permissions
 991                $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 992                print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 993
 994                # transmit file, format is single integer on a line by itself (file
 995                # size) followed by the file contents
 996                # TODO : we should copy files in blocks
 997                my $data = `cat $file_local`;
 998                $log->debug("File size : " . length($data));
 999                print length($data) . "\n";
1000                print $data;
1001            }
1002
1003            chdir "/";
1004        }
1005
1006    }
1007
1008    print "ok\n";
1009}
1010
1011sub req_ci
1012{
1013    my ( $cmd, $data ) = @_;
1014
1015    argsplit("ci");
1016
1017    #$log->debug("State : " . Dumper($state));
1018
1019    $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1020
1021    if ( @ARGV && $ARGV[0] eq 'pserver')
1022    {
1023        print "error 1 pserver access cannot commit\n";
1024        exit;
1025    }
1026
1027    if ( -e $state->{CVSROOT} . "/index" )
1028    {
1029        $log->warn("file 'index' already exists in the git repository");
1030        print "error 1 Index already exists in git repo\n";
1031        exit;
1032    }
1033
1034    my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
1035    unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )
1036    {
1037        $log->warn("lockfile '$lockfile' already exists, please try again");
1038        print "error 1 Lock file '$lockfile' already exists, please try again\n";
1039        exit;
1040    }
1041
1042    # Grab a handle to the SQLite db and do any necessary updates
1043    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1044    $updater->update();
1045
1046    my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1047    my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1048    $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
1049
1050    $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1051    $ENV{GIT_INDEX_FILE} = $file_index;
1052
1053    chdir $tmpdir;
1054
1055    # populate the temporary index based
1056    system("git-read-tree", $state->{module});
1057    unless ($? == 0)
1058    {
1059        die "Error running git-read-tree $state->{module} $file_index $!";
1060    }
1061    $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
1062
1063
1064    my @committedfiles = ();
1065
1066    # foreach file specified on the command line ...
1067    foreach my $filename ( @{$state->{args}} )
1068    {
1069        my $committedfile = $filename;
1070        $filename = filecleanup($filename);
1071
1072        next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1073
1074        my $meta = $updater->getmeta($filename);
1075
1076        my $wrev = revparse($filename);
1077
1078        my ( $filepart, $dirpart ) = filenamesplit($filename);
1079
1080        # do a checkout of the file if it part of this tree
1081        if ($wrev) {
1082            system('git-checkout-index', '-f', '-u', $filename);
1083            unless ($? == 0) {
1084                die "Error running git-checkout-index -f -u $filename : $!";
1085            }
1086        }
1087
1088        my $addflag = 0;
1089        my $rmflag = 0;
1090        $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1091        $addflag = 1 unless ( -e $filename );
1092
1093        # Do up to date checking
1094        unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1095        {
1096            # fail everything if an up to date check fails
1097            print "error 1 Up to date check failed for $filename\n";
1098            close LOCKFILE;
1099            unlink($lockfile);
1100            chdir "/";
1101            exit;
1102        }
1103
1104        push @committedfiles, $committedfile;
1105        $log->info("Committing $filename");
1106
1107        system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1108
1109        unless ( $rmflag )
1110        {
1111            $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1112            rename $state->{entries}{$filename}{modified_filename},$filename;
1113
1114            # Calculate modes to remove
1115            my $invmode = "";
1116            foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1117
1118            $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1119            system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1120        }
1121
1122        if ( $rmflag )
1123        {
1124            $log->info("Removing file '$filename'");
1125            unlink($filename);
1126            system("git-update-index", "--remove", $filename);
1127        }
1128        elsif ( $addflag )
1129        {
1130            $log->info("Adding file '$filename'");
1131            system("git-update-index", "--add", $filename);
1132        } else {
1133            $log->info("Updating file '$filename'");
1134            system("git-update-index", $filename);
1135        }
1136    }
1137
1138    unless ( scalar(@committedfiles) > 0 )
1139    {
1140        print "E No files to commit\n";
1141        print "ok\n";
1142        close LOCKFILE;
1143        unlink($lockfile);
1144        chdir "/";
1145        return;
1146    }
1147
1148    my $treehash = `git-write-tree`;
1149    my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
1150    chomp $treehash;
1151    chomp $parenthash;
1152
1153    $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1154
1155    # write our commit message out if we have one ...
1156    my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1157    print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1158    print $msg_fh "\n\nvia git-CVS emulator\n";
1159    close $msg_fh;
1160
1161    my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1162    $log->info("Commit hash : $commithash");
1163
1164    unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1165    {
1166        $log->warn("Commit failed (Invalid commit hash)");
1167        print "error 1 Commit failed (unknown reason)\n";
1168        close LOCKFILE;
1169        unlink($lockfile);
1170        chdir "/";
1171        exit;
1172    }
1173
1174    print LOCKFILE $commithash;
1175
1176    $updater->update();
1177
1178    # foreach file specified on the command line ...
1179    foreach my $filename ( @committedfiles )
1180    {
1181        $filename = filecleanup($filename);
1182
1183        my $meta = $updater->getmeta($filename);
1184
1185        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
1186
1187        $log->debug("Checked-in $dirpart : $filename");
1188
1189        if ( $meta->{filehash} eq "deleted" )
1190        {
1191            print "Remove-entry $dirpart\n";
1192            print "$filename\n";
1193        } else {
1194            print "Checked-in $dirpart\n";
1195            print "$filename\n";
1196            print "/$filepart/1.$meta->{revision}///\n";
1197        }
1198    }
1199
1200    close LOCKFILE;
1201    my $reffile = "$ENV{GIT_DIR}refs/heads/$state->{module}";
1202    unlink($reffile);
1203    rename($lockfile, $reffile);
1204    chdir "/";
1205
1206    print "ok\n";
1207}
1208
1209sub req_status
1210{
1211    my ( $cmd, $data ) = @_;
1212
1213    argsplit("status");
1214
1215    $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1216    #$log->debug("status state : " . Dumper($state));
1217
1218    # Grab a handle to the SQLite db and do any necessary updates
1219    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1220    $updater->update();
1221
1222    # if no files were specified, we need to work out what files we should be providing status on ...
1223    argsfromdir($updater);
1224
1225    # foreach file specified on the command line ...
1226    foreach my $filename ( @{$state->{args}} )
1227    {
1228        $filename = filecleanup($filename);
1229
1230        my $meta = $updater->getmeta($filename);
1231        my $oldmeta = $meta;
1232
1233        my $wrev = revparse($filename);
1234
1235        # If the working copy is an old revision, lets get that version too for comparison.
1236        if ( defined($wrev) and $wrev != $meta->{revision} )
1237        {
1238            $oldmeta = $updater->getmeta($filename, $wrev);
1239        }
1240
1241        # TODO : All possible statuses aren't yet implemented
1242        my $status;
1243        # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1244        $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1245                                    and
1246                                    ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1247                                      or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1248                                   );
1249
1250        # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1251        $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1252                                          and
1253                                          ( $state->{entries}{$filename}{unchanged}
1254                                            or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1255                                        );
1256
1257        # Need checkout if it exists in the repo but doesn't have a working copy
1258        $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1259
1260        # Locally modified if working copy and repo copy have the same revision but there are local changes
1261        $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1262
1263        # Needs Merge if working copy revision is less than repo copy and there are local changes
1264        $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1265
1266        $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1267        $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1268        $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1269        $status ||= "File had conflicts on merge" if ( 0 );
1270
1271        $status ||= "Unknown";
1272
1273        print "M ===================================================================\n";
1274        print "M File: $filename\tStatus: $status\n";
1275        if ( defined($state->{entries}{$filename}{revision}) )
1276        {
1277            print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1278        } else {
1279            print "M Working revision:\tNo entry for $filename\n";
1280        }
1281        if ( defined($meta->{revision}) )
1282        {
1283            print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1284            print "M Sticky Tag:\t\t(none)\n";
1285            print "M Sticky Date:\t\t(none)\n";
1286            print "M Sticky Options:\t\t(none)\n";
1287        } else {
1288            print "M Repository revision:\tNo revision control file\n";
1289        }
1290        print "M\n";
1291    }
1292
1293    print "ok\n";
1294}
1295
1296sub req_diff
1297{
1298    my ( $cmd, $data ) = @_;
1299
1300    argsplit("diff");
1301
1302    $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1303    #$log->debug("status state : " . Dumper($state));
1304
1305    my ($revision1, $revision2);
1306    if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1307    {
1308        $revision1 = $state->{opt}{r}[0];
1309        $revision2 = $state->{opt}{r}[1];
1310    } else {
1311        $revision1 = $state->{opt}{r};
1312    }
1313
1314    $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1315    $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1316
1317    $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1318
1319    # Grab a handle to the SQLite db and do any necessary updates
1320    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1321    $updater->update();
1322
1323    # if no files were specified, we need to work out what files we should be providing status on ...
1324    argsfromdir($updater);
1325
1326    # foreach file specified on the command line ...
1327    foreach my $filename ( @{$state->{args}} )
1328    {
1329        $filename = filecleanup($filename);
1330
1331        my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1332
1333        my $wrev = revparse($filename);
1334
1335        # We need _something_ to diff against
1336        next unless ( defined ( $wrev ) );
1337
1338        # if we have a -r switch, use it
1339        if ( defined ( $revision1 ) )
1340        {
1341            ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1342            $meta1 = $updater->getmeta($filename, $revision1);
1343            unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1344            {
1345                print "E File $filename at revision 1.$revision1 doesn't exist\n";
1346                next;
1347            }
1348            transmitfile($meta1->{filehash}, $file1);
1349        }
1350        # otherwise we just use the working copy revision
1351        else
1352        {
1353            ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1354            $meta1 = $updater->getmeta($filename, $wrev);
1355            transmitfile($meta1->{filehash}, $file1);
1356        }
1357
1358        # if we have a second -r switch, use it too
1359        if ( defined ( $revision2 ) )
1360        {
1361            ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1362            $meta2 = $updater->getmeta($filename, $revision2);
1363
1364            unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1365            {
1366                print "E File $filename at revision 1.$revision2 doesn't exist\n";
1367                next;
1368            }
1369
1370            transmitfile($meta2->{filehash}, $file2);
1371        }
1372        # otherwise we just use the working copy
1373        else
1374        {
1375            $file2 = $state->{entries}{$filename}{modified_filename};
1376        }
1377
1378        # if we have been given -r, and we don't have a $file2 yet, lets get one
1379        if ( defined ( $revision1 ) and not defined ( $file2 ) )
1380        {
1381            ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1382            $meta2 = $updater->getmeta($filename, $wrev);
1383            transmitfile($meta2->{filehash}, $file2);
1384        }
1385
1386        # We need to have retrieved something useful
1387        next unless ( defined ( $meta1 ) );
1388
1389        # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1390        next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1391                  and
1392                   ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1393                     or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1394                  );
1395
1396        # Apparently we only show diffs for locally modified files
1397        next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1398
1399        print "M Index: $filename\n";
1400        print "M ===================================================================\n";
1401        print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1402        print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1403        print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1404        print "M diff ";
1405        foreach my $opt ( keys %{$state->{opt}} )
1406        {
1407            if ( ref $state->{opt}{$opt} eq "ARRAY" )
1408            {
1409                foreach my $value ( @{$state->{opt}{$opt}} )
1410                {
1411                    print "-$opt $value ";
1412                }
1413            } else {
1414                print "-$opt ";
1415                print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1416            }
1417        }
1418        print "$filename\n";
1419
1420        $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1421
1422        ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1423
1424        if ( exists $state->{opt}{u} )
1425        {
1426            system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1427        } else {
1428            system("diff $file1 $file2 > $filediff");
1429        }
1430
1431        while ( <$fh> )
1432        {
1433            print "M $_";
1434        }
1435        close $fh;
1436    }
1437
1438    print "ok\n";
1439}
1440
1441sub req_log
1442{
1443    my ( $cmd, $data ) = @_;
1444
1445    argsplit("log");
1446
1447    $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1448    #$log->debug("log state : " . Dumper($state));
1449
1450    my ( $minrev, $maxrev );
1451    if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1452    {
1453        my $control = $2;
1454        $minrev = $1;
1455        $maxrev = $3;
1456        $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1457        $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1458        $minrev++ if ( defined($minrev) and $control eq "::" );
1459    }
1460
1461    # Grab a handle to the SQLite db and do any necessary updates
1462    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1463    $updater->update();
1464
1465    # if no files were specified, we need to work out what files we should be providing status on ...
1466    argsfromdir($updater);
1467
1468    # foreach file specified on the command line ...
1469    foreach my $filename ( @{$state->{args}} )
1470    {
1471        $filename = filecleanup($filename);
1472
1473        my $headmeta = $updater->getmeta($filename);
1474
1475        my $revisions = $updater->getlog($filename);
1476        my $totalrevisions = scalar(@$revisions);
1477
1478        if ( defined ( $minrev ) )
1479        {
1480            $log->debug("Removing revisions less than $minrev");
1481            while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1482            {
1483                pop @$revisions;
1484            }
1485        }
1486        if ( defined ( $maxrev ) )
1487        {
1488            $log->debug("Removing revisions greater than $maxrev");
1489            while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1490            {
1491                shift @$revisions;
1492            }
1493        }
1494
1495        next unless ( scalar(@$revisions) );
1496
1497        print "M \n";
1498        print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1499        print "M Working file: $filename\n";
1500        print "M head: 1.$headmeta->{revision}\n";
1501        print "M branch:\n";
1502        print "M locks: strict\n";
1503        print "M access list:\n";
1504        print "M symbolic names:\n";
1505        print "M keyword substitution: kv\n";
1506        print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1507        print "M description:\n";
1508
1509        foreach my $revision ( @$revisions )
1510        {
1511            print "M ----------------------------\n";
1512            print "M revision 1.$revision->{revision}\n";
1513            # reformat the date for log output
1514            $revision->{modified} = sprintf('%04d/%02d/%02d %s', $3, $DATE_LIST->{$2}, $1, $4 ) if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and defined($DATE_LIST->{$2}) );
1515            $revision->{author} =~ s/\s+.*//;
1516            $revision->{author} =~ s/^(.{8}).*/$1/;
1517            print "M date: $revision->{modified};  author: $revision->{author};  state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . ";  lines: +2 -3\n";
1518            my $commitmessage = $updater->commitmessage($revision->{commithash});
1519            $commitmessage =~ s/^/M /mg;
1520            print $commitmessage . "\n";
1521        }
1522        print "M =============================================================================\n";
1523    }
1524
1525    print "ok\n";
1526}
1527
1528sub req_annotate
1529{
1530    my ( $cmd, $data ) = @_;
1531
1532    argsplit("annotate");
1533
1534    $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1535    #$log->debug("status state : " . Dumper($state));
1536
1537    # Grab a handle to the SQLite db and do any necessary updates
1538    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1539    $updater->update();
1540
1541    # if no files were specified, we need to work out what files we should be providing annotate on ...
1542    argsfromdir($updater);
1543
1544    # we'll need a temporary checkout dir
1545    my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1546    my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1547    $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1548
1549    $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1550    $ENV{GIT_INDEX_FILE} = $file_index;
1551
1552    chdir $tmpdir;
1553
1554    # foreach file specified on the command line ...
1555    foreach my $filename ( @{$state->{args}} )
1556    {
1557        $filename = filecleanup($filename);
1558
1559        my $meta = $updater->getmeta($filename);
1560
1561        next unless ( $meta->{revision} );
1562
1563        # get all the commits that this file was in
1564        # in dense format -- aka skip dead revisions
1565        my $revisions   = $updater->gethistorydense($filename);
1566        my $lastseenin  = $revisions->[0][2];
1567
1568        # populate the temporary index based on the latest commit were we saw
1569        # the file -- but do it cheaply without checking out any files
1570        # TODO: if we got a revision from the client, use that instead
1571        # to look up the commithash in sqlite (still good to default to
1572        # the current head as we do now)
1573        system("git-read-tree", $lastseenin);
1574        unless ($? == 0)
1575        {
1576            die "Error running git-read-tree $lastseenin $file_index $!";
1577        }
1578        $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1579
1580        # do a checkout of the file
1581        system('git-checkout-index', '-f', '-u', $filename);
1582        unless ($? == 0) {
1583            die "Error running git-checkout-index -f -u $filename : $!";
1584        }
1585
1586        $log->info("Annotate $filename");
1587
1588        # Prepare a file with the commits from the linearized
1589        # history that annotate should know about. This prevents
1590        # git-jsannotate telling us about commits we are hiding
1591        # from the client.
1592
1593        open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1594        for (my $i=0; $i < @$revisions; $i++)
1595        {
1596            print ANNOTATEHINTS $revisions->[$i][2];
1597            if ($i+1 < @$revisions) { # have we got a parent?
1598                print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1599            }
1600            print ANNOTATEHINTS "\n";
1601        }
1602
1603        print ANNOTATEHINTS "\n";
1604        close ANNOTATEHINTS;
1605
1606        my $annotatecmd = 'git-annotate';
1607        open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1608            or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1609        my $metadata = {};
1610        print "E Annotations for $filename\n";
1611        print "E ***************\n";
1612        while ( <ANNOTATE> )
1613        {
1614            if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1615            {
1616                my $commithash = $1;
1617                my $data = $2;
1618                unless ( defined ( $metadata->{$commithash} ) )
1619                {
1620                    $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1621                    $metadata->{$commithash}{author} =~ s/\s+.*//;
1622                    $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1623                    $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1624                }
1625                printf("M 1.%-5d      (%-8s %10s): %s\n",
1626                    $metadata->{$commithash}{revision},
1627                    $metadata->{$commithash}{author},
1628                    $metadata->{$commithash}{modified},
1629                    $data
1630                );
1631            } else {
1632                $log->warn("Error in annotate output! LINE: $_");
1633                print "E Annotate error \n";
1634                next;
1635            }
1636        }
1637        close ANNOTATE;
1638    }
1639
1640    # done; get out of the tempdir
1641    chdir "/";
1642
1643    print "ok\n";
1644
1645}
1646
1647# This method takes the state->{arguments} array and produces two new arrays.
1648# The first is $state->{args} which is everything before the '--' argument, and
1649# the second is $state->{files} which is everything after it.
1650sub argsplit
1651{
1652    return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1653
1654    my $type = shift;
1655
1656    $state->{args} = [];
1657    $state->{files} = [];
1658    $state->{opt} = {};
1659
1660    if ( defined($type) )
1661    {
1662        my $opt = {};
1663        $opt = { A => 0, N => 0, P => 0, R => 0, c => 0, f => 0, l => 0, n => 0, p => 0, s => 0, r => 1, D => 1, d => 1, k => 1, j => 1, } if ( $type eq "co" );
1664        $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1665        $opt = { A => 0, P => 0, C => 0, d => 0, f => 0, l => 0, R => 0, p => 0, k => 1, r => 1, D => 1, j => 1, I => 1, W => 1 } if ( $type eq "update" );
1666        $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1667        $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1668        $opt = { k => 1, m => 1 } if ( $type eq "add" );
1669        $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1670        $opt = { l => 0, b => 0, h => 0, R => 0, t => 0, N => 0, S => 0, r => 1, d => 1, s => 1, w => 1 } if ( $type eq "log" );
1671
1672
1673        while ( scalar ( @{$state->{arguments}} ) > 0 )
1674        {
1675            my $arg = shift @{$state->{arguments}};
1676
1677            next if ( $arg eq "--" );
1678            next unless ( $arg =~ /\S/ );
1679
1680            # if the argument looks like a switch
1681            if ( $arg =~ /^-(\w)(.*)/ )
1682            {
1683                # if it's a switch that takes an argument
1684                if ( $opt->{$1} )
1685                {
1686                    # If this switch has already been provided
1687                    if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1688                    {
1689                        $state->{opt}{$1} = [ $state->{opt}{$1} ];
1690                        if ( length($2) > 0 )
1691                        {
1692                            push @{$state->{opt}{$1}},$2;
1693                        } else {
1694                            push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1695                        }
1696                    } else {
1697                        # if there's extra data in the arg, use that as the argument for the switch
1698                        if ( length($2) > 0 )
1699                        {
1700                            $state->{opt}{$1} = $2;
1701                        } else {
1702                            $state->{opt}{$1} = shift @{$state->{arguments}};
1703                        }
1704                    }
1705                } else {
1706                    $state->{opt}{$1} = undef;
1707                }
1708            }
1709            else
1710            {
1711                push @{$state->{args}}, $arg;
1712            }
1713        }
1714    }
1715    else
1716    {
1717        my $mode = 0;
1718
1719        foreach my $value ( @{$state->{arguments}} )
1720        {
1721            if ( $value eq "--" )
1722            {
1723                $mode++;
1724                next;
1725            }
1726            push @{$state->{args}}, $value if ( $mode == 0 );
1727            push @{$state->{files}}, $value if ( $mode == 1 );
1728        }
1729    }
1730}
1731
1732# This method uses $state->{directory} to populate $state->{args} with a list of filenames
1733sub argsfromdir
1734{
1735    my $updater = shift;
1736
1737    $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
1738
1739    return if ( scalar ( @{$state->{args}} ) > 1 );
1740
1741    my @gethead = @{$updater->gethead};
1742
1743    # push added files
1744    foreach my $file (keys %{$state->{entries}}) {
1745        if ( exists $state->{entries}{$file}{revision} &&
1746                $state->{entries}{$file}{revision} == 0 )
1747        {
1748            push @gethead, { name => $file, filehash => 'added' };
1749        }
1750    }
1751
1752    if ( scalar(@{$state->{args}}) == 1 )
1753    {
1754        my $arg = $state->{args}[0];
1755        $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
1756
1757        $log->info("Only one arg specified, checking for directory expansion on '$arg'");
1758
1759        foreach my $file ( @gethead )
1760        {
1761            next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1762            next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg  );
1763            push @{$state->{args}}, $file->{name};
1764        }
1765
1766        shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
1767    } else {
1768        $log->info("Only one arg specified, populating file list automatically");
1769
1770        $state->{args} = [];
1771
1772        foreach my $file ( @gethead )
1773        {
1774            next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1775            next unless ( $file->{name} =~ s/^$state->{prependdir}// );
1776            push @{$state->{args}}, $file->{name};
1777        }
1778    }
1779}
1780
1781# This method cleans up the $state variable after a command that uses arguments has run
1782sub statecleanup
1783{
1784    $state->{files} = [];
1785    $state->{args} = [];
1786    $state->{arguments} = [];
1787    $state->{entries} = {};
1788}
1789
1790sub revparse
1791{
1792    my $filename = shift;
1793
1794    return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1795
1796    return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1797    return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1798
1799    return undef;
1800}
1801
1802# This method takes a file hash and does a CVS "file transfer" which transmits the
1803# size of the file, and then the file contents.
1804# If a second argument $targetfile is given, the file is instead written out to
1805# a file by the name of $targetfile
1806sub transmitfile
1807{
1808    my $filehash = shift;
1809    my $targetfile = shift;
1810
1811    if ( defined ( $filehash ) and $filehash eq "deleted" )
1812    {
1813        $log->warn("filehash is 'deleted'");
1814        return;
1815    }
1816
1817    die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1818
1819    my $type = `git-cat-file -t $filehash`;
1820    chomp $type;
1821
1822    die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1823
1824    my $size = `git-cat-file -s $filehash`;
1825    chomp $size;
1826
1827    $log->debug("transmitfile($filehash) size=$size, type=$type");
1828
1829    if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1830    {
1831        if ( defined ( $targetfile ) )
1832        {
1833            open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1834            print NEWFILE $_ while ( <$fh> );
1835            close NEWFILE;
1836        } else {
1837            print "$size\n";
1838            print while ( <$fh> );
1839        }
1840        close $fh or die ("Couldn't close filehandle for transmitfile()");
1841    } else {
1842        die("Couldn't execute git-cat-file");
1843    }
1844}
1845
1846# This method takes a file name, and returns ( $dirpart, $filepart ) which
1847# refers to the directory portion and the file portion of the filename
1848# respectively
1849sub filenamesplit
1850{
1851    my $filename = shift;
1852    my $fixforlocaldir = shift;
1853
1854    my ( $filepart, $dirpart ) = ( $filename, "." );
1855    ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1856    $dirpart .= "/";
1857
1858    if ( $fixforlocaldir )
1859    {
1860        $dirpart =~ s/^$state->{prependdir}//;
1861    }
1862
1863    return ( $filepart, $dirpart );
1864}
1865
1866sub filecleanup
1867{
1868    my $filename = shift;
1869
1870    return undef unless(defined($filename));
1871    if ( $filename =~ /^\// )
1872    {
1873        print "E absolute filenames '$filename' not supported by server\n";
1874        return undef;
1875    }
1876
1877    $filename =~ s/^\.\///g;
1878    $filename = $state->{prependdir} . $filename;
1879    return $filename;
1880}
1881
1882package GITCVS::log;
1883
1884####
1885#### Copyright The Open University UK - 2006.
1886####
1887#### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1888####          Martin Langhoff <martin@catalyst.net.nz>
1889####
1890####
1891
1892use strict;
1893use warnings;
1894
1895=head1 NAME
1896
1897GITCVS::log
1898
1899=head1 DESCRIPTION
1900
1901This module provides very crude logging with a similar interface to
1902Log::Log4perl
1903
1904=head1 METHODS
1905
1906=cut
1907
1908=head2 new
1909
1910Creates a new log object, optionally you can specify a filename here to
1911indicate the file to log to. If no log file is specified, you can specify one
1912later with method setfile, or indicate you no longer want logging with method
1913nofile.
1914
1915Until one of these methods is called, all log calls will buffer messages ready
1916to write out.
1917
1918=cut
1919sub new
1920{
1921    my $class = shift;
1922    my $filename = shift;
1923
1924    my $self = {};
1925
1926    bless $self, $class;
1927
1928    if ( defined ( $filename ) )
1929    {
1930        open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1931    }
1932
1933    return $self;
1934}
1935
1936=head2 setfile
1937
1938This methods takes a filename, and attempts to open that file as the log file.
1939If successful, all buffered data is written out to the file, and any further
1940logging is written directly to the file.
1941
1942=cut
1943sub setfile
1944{
1945    my $self = shift;
1946    my $filename = shift;
1947
1948    if ( defined ( $filename ) )
1949    {
1950        open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1951    }
1952
1953    return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1954
1955    while ( my $line = shift @{$self->{buffer}} )
1956    {
1957        print {$self->{fh}} $line;
1958    }
1959}
1960
1961=head2 nofile
1962
1963This method indicates no logging is going to be used. It flushes any entries in
1964the internal buffer, and sets a flag to ensure no further data is put there.
1965
1966=cut
1967sub nofile
1968{
1969    my $self = shift;
1970
1971    $self->{nolog} = 1;
1972
1973    return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1974
1975    $self->{buffer} = [];
1976}
1977
1978=head2 _logopen
1979
1980Internal method. Returns true if the log file is open, false otherwise.
1981
1982=cut
1983sub _logopen
1984{
1985    my $self = shift;
1986
1987    return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
1988    return 0;
1989}
1990
1991=head2 debug info warn fatal
1992
1993These four methods are wrappers to _log. They provide the actual interface for
1994logging data.
1995
1996=cut
1997sub debug { my $self = shift; $self->_log("debug", @_); }
1998sub info  { my $self = shift; $self->_log("info" , @_); }
1999sub warn  { my $self = shift; $self->_log("warn" , @_); }
2000sub fatal { my $self = shift; $self->_log("fatal", @_); }
2001
2002=head2 _log
2003
2004This is an internal method called by the logging functions. It generates a
2005timestamp and pushes the logged line either to file, or internal buffer.
2006
2007=cut
2008sub _log
2009{
2010    my $self = shift;
2011    my $level = shift;
2012
2013    return if ( $self->{nolog} );
2014
2015    my @time = localtime;
2016    my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2017        $time[5] + 1900,
2018        $time[4] + 1,
2019        $time[3],
2020        $time[2],
2021        $time[1],
2022        $time[0],
2023        uc $level,
2024    );
2025
2026    if ( $self->_logopen )
2027    {
2028        print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
2029    } else {
2030        push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
2031    }
2032}
2033
2034=head2 DESTROY
2035
2036This method simply closes the file handle if one is open
2037
2038=cut
2039sub DESTROY
2040{
2041    my $self = shift;
2042
2043    if ( $self->_logopen )
2044    {
2045        close $self->{fh};
2046    }
2047}
2048
2049package GITCVS::updater;
2050
2051####
2052#### Copyright The Open University UK - 2006.
2053####
2054#### Authors: Martyn Smith    <martyn@catalyst.net.nz>
2055####          Martin Langhoff <martin@catalyst.net.nz>
2056####
2057####
2058
2059use strict;
2060use warnings;
2061use DBI;
2062
2063=head1 METHODS
2064
2065=cut
2066
2067=head2 new
2068
2069=cut
2070sub new
2071{
2072    my $class = shift;
2073    my $config = shift;
2074    my $module = shift;
2075    my $log = shift;
2076
2077    die "Need to specify a git repository" unless ( defined($config) and -d $config );
2078    die "Need to specify a module" unless ( defined($module) );
2079
2080    $class = ref($class) || $class;
2081
2082    my $self = {};
2083
2084    bless $self, $class;
2085
2086    $self->{dbdir} = $config . "/";
2087    die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
2088
2089    $self->{module} = $module;
2090    $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
2091
2092    $self->{git_path} = $config . "/";
2093
2094    $self->{log} = $log;
2095
2096    die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2097
2098    $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
2099
2100    $self->{tables} = {};
2101    foreach my $table ( $self->{dbh}->tables )
2102    {
2103        $table =~ s/^"//;
2104        $table =~ s/"$//;
2105        $self->{tables}{$table} = 1;
2106    }
2107
2108    # Construct the revision table if required
2109    unless ( $self->{tables}{revision} )
2110    {
2111        $self->{dbh}->do("
2112            CREATE TABLE revision (
2113                name       TEXT NOT NULL,
2114                revision   INTEGER NOT NULL,
2115                filehash   TEXT NOT NULL,
2116                commithash TEXT NOT NULL,
2117                author     TEXT NOT NULL,
2118                modified   TEXT NOT NULL,
2119                mode       TEXT NOT NULL
2120            )
2121        ");
2122        $self->{dbh}->do("
2123            CREATE INDEX revision_ix1
2124            ON revision (name,revision)
2125        ");
2126        $self->{dbh}->do("
2127            CREATE INDEX revision_ix2
2128            ON revision (name,commithash)
2129        ");
2130    }
2131
2132    # Construct the head table if required
2133    unless ( $self->{tables}{head} )
2134    {
2135        $self->{dbh}->do("
2136            CREATE TABLE head (
2137                name       TEXT NOT NULL,
2138                revision   INTEGER NOT NULL,
2139                filehash   TEXT NOT NULL,
2140                commithash TEXT NOT NULL,
2141                author     TEXT NOT NULL,
2142                modified   TEXT NOT NULL,
2143                mode       TEXT NOT NULL
2144            )
2145        ");
2146        $self->{dbh}->do("
2147            CREATE INDEX head_ix1
2148            ON head (name)
2149        ");
2150    }
2151
2152    # Construct the properties table if required
2153    unless ( $self->{tables}{properties} )
2154    {
2155        $self->{dbh}->do("
2156            CREATE TABLE properties (
2157                key        TEXT NOT NULL PRIMARY KEY,
2158                value      TEXT
2159            )
2160        ");
2161    }
2162
2163    # Construct the commitmsgs table if required
2164    unless ( $self->{tables}{commitmsgs} )
2165    {
2166        $self->{dbh}->do("
2167            CREATE TABLE commitmsgs (
2168                key        TEXT NOT NULL PRIMARY KEY,
2169                value      TEXT
2170            )
2171        ");
2172    }
2173
2174    return $self;
2175}
2176
2177=head2 update
2178
2179=cut
2180sub update
2181{
2182    my $self = shift;
2183
2184    # first lets get the commit list
2185    $ENV{GIT_DIR} = $self->{git_path};
2186
2187    my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2188    unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2189    {
2190        die("Invalid module '$self->{module}'");
2191    }
2192
2193
2194    my $git_log;
2195    my $lastcommit = $self->_get_prop("last_commit");
2196
2197    # Start exclusive lock here...
2198    $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2199
2200    # TODO: log processing is memory bound
2201    # if we can parse into a 2nd file that is in reverse order
2202    # we can probably do something really efficient
2203    my @git_log_params = ('--pretty', '--parents', '--topo-order');
2204
2205    if (defined $lastcommit) {
2206        push @git_log_params, "$lastcommit..$self->{module}";
2207    } else {
2208        push @git_log_params, $self->{module};
2209    }
2210    # git-rev-list is the backend / plumbing version of git-log
2211    open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2212
2213    my @commits;
2214
2215    my %commit = ();
2216
2217    while ( <GITLOG> )
2218    {
2219        chomp;
2220        if (m/^commit\s+(.*)$/) {
2221            # on ^commit lines put the just seen commit in the stack
2222            # and prime things for the next one
2223            if (keys %commit) {
2224                my %copy = %commit;
2225                unshift @commits, \%copy;
2226                %commit = ();
2227            }
2228            my @parents = split(m/\s+/, $1);
2229            $commit{hash} = shift @parents;
2230            $commit{parents} = \@parents;
2231        } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2232            # on rfc822-like lines seen before we see any message,
2233            # lowercase the entry and put it in the hash as key-value
2234            $commit{lc($1)} = $2;
2235        } else {
2236            # message lines - skip initial empty line
2237            # and trim whitespace
2238            if (!exists($commit{message}) && m/^\s*$/) {
2239                # define it to mark the end of headers
2240                $commit{message} = '';
2241                next;
2242            }
2243            s/^\s+//; s/\s+$//; # trim ws
2244            $commit{message} .= $_ . "\n";
2245        }
2246    }
2247    close GITLOG;
2248
2249    unshift @commits, \%commit if ( keys %commit );
2250
2251    # Now all the commits are in the @commits bucket
2252    # ordered by time DESC. for each commit that needs processing,
2253    # determine whether it's following the last head we've seen or if
2254    # it's on its own branch, grab a file list, and add whatever's changed
2255    # NOTE: $lastcommit refers to the last commit from previous run
2256    #       $lastpicked is the last commit we picked in this run
2257    my $lastpicked;
2258    my $head = {};
2259    if (defined $lastcommit) {
2260        $lastpicked = $lastcommit;
2261    }
2262
2263    my $committotal = scalar(@commits);
2264    my $commitcount = 0;
2265
2266    # Load the head table into $head (for cached lookups during the update process)
2267    foreach my $file ( @{$self->gethead()} )
2268    {
2269        $head->{$file->{name}} = $file;
2270    }
2271
2272    foreach my $commit ( @commits )
2273    {
2274        $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2275        if (defined $lastpicked)
2276        {
2277            if (!in_array($lastpicked, @{$commit->{parents}}))
2278            {
2279                # skip, we'll see this delta
2280                # as part of a merge later
2281                # warn "skipping off-track  $commit->{hash}\n";
2282                next;
2283            } elsif (@{$commit->{parents}} > 1) {
2284                # it is a merge commit, for each parent that is
2285                # not $lastpicked, see if we can get a log
2286                # from the merge-base to that parent to put it
2287                # in the message as a merge summary.
2288                my @parents = @{$commit->{parents}};
2289                foreach my $parent (@parents) {
2290                    # git-merge-base can potentially (but rarely) throw
2291                    # several candidate merge bases. let's assume
2292                    # that the first one is the best one.
2293                    if ($parent eq $lastpicked) {
2294                        next;
2295                    }
2296                    open my $p, 'git-merge-base '. $lastpicked . ' '
2297                    . $parent . '|';
2298                    my @output = (<$p>);
2299                    close $p;
2300                    my $base = join('', @output);
2301                    chomp $base;
2302                    if ($base) {
2303                        my @merged;
2304                        # print "want to log between  $base $parent \n";
2305                        open(GITLOG, '-|', 'git-log', "$base..$parent")
2306                        or die "Cannot call git-log: $!";
2307                        my $mergedhash;
2308                        while (<GITLOG>) {
2309                            chomp;
2310                            if (!defined $mergedhash) {
2311                                if (m/^commit\s+(.+)$/) {
2312                                    $mergedhash = $1;
2313                                } else {
2314                                    next;
2315                                }
2316                            } else {
2317                                # grab the first line that looks non-rfc822
2318                                # aka has content after leading space
2319                                if (m/^\s+(\S.*)$/) {
2320                                    my $title = $1;
2321                                    $title = substr($title,0,100); # truncate
2322                                    unshift @merged, "$mergedhash $title";
2323                                    undef $mergedhash;
2324                                }
2325                            }
2326                        }
2327                        close GITLOG;
2328                        if (@merged) {
2329                            $commit->{mergemsg} = $commit->{message};
2330                            $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2331                            foreach my $summary (@merged) {
2332                                $commit->{mergemsg} .= "\t$summary\n";
2333                            }
2334                            $commit->{mergemsg} .= "\n\n";
2335                            # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2336                        }
2337                    }
2338                }
2339            }
2340        }
2341
2342        # convert the date to CVS-happy format
2343        $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2344
2345        if ( defined ( $lastpicked ) )
2346        {
2347            my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2348            local ($/) = "\0";
2349            while ( <FILELIST> )
2350            {
2351                chomp;
2352                unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
2353                {
2354                    die("Couldn't process git-diff-tree line : $_");
2355                }
2356                my ($mode, $hash, $change) = ($1, $2, $3);
2357                my $name = <FILELIST>;
2358                chomp($name);
2359
2360                # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
2361
2362                my $git_perms = "";
2363                $git_perms .= "r" if ( $mode & 4 );
2364                $git_perms .= "w" if ( $mode & 2 );
2365                $git_perms .= "x" if ( $mode & 1 );
2366                $git_perms = "rw" if ( $git_perms eq "" );
2367
2368                if ( $change eq "D" )
2369                {
2370                    #$log->debug("DELETE   $name");
2371                    $head->{$name} = {
2372                        name => $name,
2373                        revision => $head->{$name}{revision} + 1,
2374                        filehash => "deleted",
2375                        commithash => $commit->{hash},
2376                        modified => $commit->{date},
2377                        author => $commit->{author},
2378                        mode => $git_perms,
2379                    };
2380                    $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2381                }
2382                elsif ( $change eq "M" )
2383                {
2384                    #$log->debug("MODIFIED $name");
2385                    $head->{$name} = {
2386                        name => $name,
2387                        revision => $head->{$name}{revision} + 1,
2388                        filehash => $hash,
2389                        commithash => $commit->{hash},
2390                        modified => $commit->{date},
2391                        author => $commit->{author},
2392                        mode => $git_perms,
2393                    };
2394                    $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2395                }
2396                elsif ( $change eq "A" )
2397                {
2398                    #$log->debug("ADDED    $name");
2399                    $head->{$name} = {
2400                        name => $name,
2401                        revision => 1,
2402                        filehash => $hash,
2403                        commithash => $commit->{hash},
2404                        modified => $commit->{date},
2405                        author => $commit->{author},
2406                        mode => $git_perms,
2407                    };
2408                    $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2409                }
2410                else
2411                {
2412                    $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
2413                    die;
2414                }
2415            }
2416            close FILELIST;
2417        } else {
2418            # this is used to detect files removed from the repo
2419            my $seen_files = {};
2420
2421            my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2422            local $/ = "\0";
2423            while ( <FILELIST> )
2424            {
2425                chomp;
2426                unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
2427                {
2428                    die("Couldn't process git-ls-tree line : $_");
2429                }
2430
2431                my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2432
2433                $seen_files->{$git_filename} = 1;
2434
2435                my ( $oldhash, $oldrevision, $oldmode ) = (
2436                    $head->{$git_filename}{filehash},
2437                    $head->{$git_filename}{revision},
2438                    $head->{$git_filename}{mode}
2439                );
2440
2441                if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2442                {
2443                    $git_perms = "";
2444                    $git_perms .= "r" if ( $1 & 4 );
2445                    $git_perms .= "w" if ( $1 & 2 );
2446                    $git_perms .= "x" if ( $1 & 1 );
2447                } else {
2448                    $git_perms = "rw";
2449                }
2450
2451                # unless the file exists with the same hash, we need to update it ...
2452                unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2453                {
2454                    my $newrevision = ( $oldrevision or 0 ) + 1;
2455
2456                    $head->{$git_filename} = {
2457                        name => $git_filename,
2458                        revision => $newrevision,
2459                        filehash => $git_hash,
2460                        commithash => $commit->{hash},
2461                        modified => $commit->{date},
2462                        author => $commit->{author},
2463                        mode => $git_perms,
2464                    };
2465
2466
2467                    $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2468                }
2469            }
2470            close FILELIST;
2471
2472            # Detect deleted files
2473            foreach my $file ( keys %$head )
2474            {
2475                unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2476                {
2477                    $head->{$file}{revision}++;
2478                    $head->{$file}{filehash} = "deleted";
2479                    $head->{$file}{commithash} = $commit->{hash};
2480                    $head->{$file}{modified} = $commit->{date};
2481                    $head->{$file}{author} = $commit->{author};
2482
2483                    $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2484                }
2485            }
2486            # END : "Detect deleted files"
2487        }
2488
2489
2490        if (exists $commit->{mergemsg})
2491        {
2492            $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
2493        }
2494
2495        $lastpicked = $commit->{hash};
2496
2497        $self->_set_prop("last_commit", $commit->{hash});
2498    }
2499
2500    $self->delete_head();
2501    foreach my $file ( keys %$head )
2502    {
2503        $self->insert_head(
2504            $file,
2505            $head->{$file}{revision},
2506            $head->{$file}{filehash},
2507            $head->{$file}{commithash},
2508            $head->{$file}{modified},
2509            $head->{$file}{author},
2510            $head->{$file}{mode},
2511        );
2512    }
2513    # invalidate the gethead cache
2514    $self->{gethead_cache} = undef;
2515
2516
2517    # Ending exclusive lock here
2518    $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2519}
2520
2521sub insert_rev
2522{
2523    my $self = shift;
2524    my $name = shift;
2525    my $revision = shift;
2526    my $filehash = shift;
2527    my $commithash = shift;
2528    my $modified = shift;
2529    my $author = shift;
2530    my $mode = shift;
2531
2532    my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2533    $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2534}
2535
2536sub insert_mergelog
2537{
2538    my $self = shift;
2539    my $key = shift;
2540    my $value = shift;
2541
2542    my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2543    $insert_mergelog->execute($key, $value);
2544}
2545
2546sub delete_head
2547{
2548    my $self = shift;
2549
2550    my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2551    $delete_head->execute();
2552}
2553
2554sub insert_head
2555{
2556    my $self = shift;
2557    my $name = shift;
2558    my $revision = shift;
2559    my $filehash = shift;
2560    my $commithash = shift;
2561    my $modified = shift;
2562    my $author = shift;
2563    my $mode = shift;
2564
2565    my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2566    $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2567}
2568
2569sub _headrev
2570{
2571    my $self = shift;
2572    my $filename = shift;
2573
2574    my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2575    $db_query->execute($filename);
2576    my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2577
2578    return ( $hash, $revision, $mode );
2579}
2580
2581sub _get_prop
2582{
2583    my $self = shift;
2584    my $key = shift;
2585
2586    my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2587    $db_query->execute($key);
2588    my ( $value ) = $db_query->fetchrow_array;
2589
2590    return $value;
2591}
2592
2593sub _set_prop
2594{
2595    my $self = shift;
2596    my $key = shift;
2597    my $value = shift;
2598
2599    my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2600    $db_query->execute($value, $key);
2601
2602    unless ( $db_query->rows )
2603    {
2604        $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2605        $db_query->execute($key, $value);
2606    }
2607
2608    return $value;
2609}
2610
2611=head2 gethead
2612
2613=cut
2614
2615sub gethead
2616{
2617    my $self = shift;
2618
2619    return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2620
2621    my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2622    $db_query->execute();
2623
2624    my $tree = [];
2625    while ( my $file = $db_query->fetchrow_hashref )
2626    {
2627        push @$tree, $file;
2628    }
2629
2630    $self->{gethead_cache} = $tree;
2631
2632    return $tree;
2633}
2634
2635=head2 getlog
2636
2637=cut
2638
2639sub getlog
2640{
2641    my $self = shift;
2642    my $filename = shift;
2643
2644    my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2645    $db_query->execute($filename);
2646
2647    my $tree = [];
2648    while ( my $file = $db_query->fetchrow_hashref )
2649    {
2650        push @$tree, $file;
2651    }
2652
2653    return $tree;
2654}
2655
2656=head2 getmeta
2657
2658This function takes a filename (with path) argument and returns a hashref of
2659metadata for that file.
2660
2661=cut
2662
2663sub getmeta
2664{
2665    my $self = shift;
2666    my $filename = shift;
2667    my $revision = shift;
2668
2669    my $db_query;
2670    if ( defined($revision) and $revision =~ /^\d+$/ )
2671    {
2672        $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2673        $db_query->execute($filename, $revision);
2674    }
2675    elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2676    {
2677        $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2678        $db_query->execute($filename, $revision);
2679    } else {
2680        $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2681        $db_query->execute($filename);
2682    }
2683
2684    return $db_query->fetchrow_hashref;
2685}
2686
2687=head2 commitmessage
2688
2689this function takes a commithash and returns the commit message for that commit
2690
2691=cut
2692sub commitmessage
2693{
2694    my $self = shift;
2695    my $commithash = shift;
2696
2697    die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2698
2699    my $db_query;
2700    $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2701    $db_query->execute($commithash);
2702
2703    my ( $message ) = $db_query->fetchrow_array;
2704
2705    if ( defined ( $message ) )
2706    {
2707        $message .= " " if ( $message =~ /\n$/ );
2708        return $message;
2709    }
2710
2711    my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2712    shift @lines while ( $lines[0] =~ /\S/ );
2713    $message = join("",@lines);
2714    $message .= " " if ( $message =~ /\n$/ );
2715    return $message;
2716}
2717
2718=head2 gethistory
2719
2720This function takes a filename (with path) argument and returns an arrayofarrays
2721containing revision,filehash,commithash ordered by revision descending
2722
2723=cut
2724sub gethistory
2725{
2726    my $self = shift;
2727    my $filename = shift;
2728
2729    my $db_query;
2730    $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2731    $db_query->execute($filename);
2732
2733    return $db_query->fetchall_arrayref;
2734}
2735
2736=head2 gethistorydense
2737
2738This function takes a filename (with path) argument and returns an arrayofarrays
2739containing revision,filehash,commithash ordered by revision descending.
2740
2741This version of gethistory skips deleted entries -- so it is useful for annotate.
2742The 'dense' part is a reference to a '--dense' option available for git-rev-list
2743and other git tools that depend on it.
2744
2745=cut
2746sub gethistorydense
2747{
2748    my $self = shift;
2749    my $filename = shift;
2750
2751    my $db_query;
2752    $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2753    $db_query->execute($filename);
2754
2755    return $db_query->fetchall_arrayref;
2756}
2757
2758=head2 in_array()
2759
2760from Array::PAT - mimics the in_array() function
2761found in PHP. Yuck but works for small arrays.
2762
2763=cut
2764sub in_array
2765{
2766    my ($check, @array) = @_;
2767    my $retval = 0;
2768    foreach my $test (@array){
2769        if($check eq $test){
2770            $retval =  1;
2771        }
2772    }
2773    return $retval;
2774}
2775
2776=head2 safe_pipe_capture
2777
2778an alternative to `command` that allows input to be passed as an array
2779to work around shell problems with weird characters in arguments
2780
2781=cut
2782sub safe_pipe_capture {
2783
2784    my @output;
2785
2786    if (my $pid = open my $child, '-|') {
2787        @output = (<$child>);
2788        close $child or die join(' ',@_).": $! $?";
2789    } else {
2790        exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2791    }
2792    return wantarray ? @output : join('',@output);
2793}
2794
2795
27961;