git-cvsserver.perl

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