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 = { prependdir => '' };
  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 command line ...
 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 command line ...
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 command line ...
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 command line ...
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 command line ...
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 command line ...
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 command line ...
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     my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2133     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2134     {
2135         die("Invalid module '$self->{module}'");
2136     }
2137
2138
2139     my $git_log;
2140     my $lastcommit = $self->_get_prop("last_commit");
2141
2142     # Start exclusive lock here...
2143     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2144
2145     # TODO: log processing is memory bound
2146     # if we can parse into a 2nd file that is in reverse order
2147     # we can probably do something really efficient
2148     my @git_log_params = ('--pretty', '--parents', '--topo-order');
2149
2150     if (defined $lastcommit) {
2151         push @git_log_params, "$lastcommit..$self->{module}";
2152     } else {
2153         push @git_log_params, $self->{module};
2154     }
2155     # git-rev-list is the backend / plumbing version of git-log
2156     open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2157
2158     my @commits;
2159
2160     my %commit = ();
2161
2162     while ( <GITLOG> )
2163     {
2164         chomp;
2165         if (m/^commit\s+(.*)$/) {
2166             # on ^commit lines put the just seen commit in the stack
2167             # and prime things for the next one
2168             if (keys %commit) {
2169                 my %copy = %commit;
2170                 unshift @commits, \%copy;
2171                 %commit = ();
2172             }
2173             my @parents = split(m/\s+/, $1);
2174             $commit{hash} = shift @parents;
2175             $commit{parents} = \@parents;
2176         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2177             # on rfc822-like lines seen before we see any message,
2178             # lowercase the entry and put it in the hash as key-value
2179             $commit{lc($1)} = $2;
2180         } else {
2181             # message lines - skip initial empty line
2182             # and trim whitespace
2183             if (!exists($commit{message}) && m/^\s*$/) {
2184                 # define it to mark the end of headers
2185                 $commit{message} = '';
2186                 next;
2187             }
2188             s/^\s+//; s/\s+$//; # trim ws
2189             $commit{message} .= $_ . "\n";
2190         }
2191     }
2192     close GITLOG;
2193
2194     unshift @commits, \%commit if ( keys %commit );
2195
2196     # Now all the commits are in the @commits bucket
2197     # ordered by time DESC. for each commit that needs processing,
2198     # determine whether it's following the last head we've seen or if
2199     # it's on its own branch, grab a file list, and add whatever's changed
2200     # NOTE: $lastcommit refers to the last commit from previous run
2201     #       $lastpicked is the last commit we picked in this run
2202     my $lastpicked;
2203     my $head = {};
2204     if (defined $lastcommit) {
2205         $lastpicked = $lastcommit;
2206     }
2207
2208     my $committotal = scalar(@commits);
2209     my $commitcount = 0;
2210
2211     # Load the head table into $head (for cached lookups during the update process)
2212     foreach my $file ( @{$self->gethead()} )
2213     {
2214         $head->{$file->{name}} = $file;
2215     }
2216
2217     foreach my $commit ( @commits )
2218     {
2219         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2220         if (defined $lastpicked)
2221         {
2222             if (!in_array($lastpicked, @{$commit->{parents}}))
2223             {
2224                 # skip, we'll see this delta
2225                 # as part of a merge later
2226                 # warn "skipping off-track  $commit->{hash}\n";
2227                 next;
2228             } elsif (@{$commit->{parents}} > 1) {
2229                 # it is a merge commit, for each parent that is
2230                 # not $lastpicked, see if we can get a log
2231                 # from the merge-base to that parent to put it
2232                 # in the message as a merge summary.
2233                 my @parents = @{$commit->{parents}};
2234                 foreach my $parent (@parents) {
2235                     # git-merge-base can potentially (but rarely) throw
2236                     # several candidate merge bases. let's assume
2237                     # that the first one is the best one.
2238                     if ($parent eq $lastpicked) {
2239                         next;
2240                     }
2241                     open my $p, 'git-merge-base '. $lastpicked . ' '
2242                     . $parent . '|';
2243                     my @output = (<$p>);
2244                     close $p;
2245                     my $base = join('', @output);
2246                     chomp $base;
2247                     if ($base) {
2248                         my @merged;
2249                         # print "want to log between  $base $parent \n";
2250                         open(GITLOG, '-|', 'git-log', "$base..$parent")
2251                         or die "Cannot call git-log: $!";
2252                         my $mergedhash;
2253                         while (<GITLOG>) {
2254                             chomp;
2255                             if (!defined $mergedhash) {
2256                                 if (m/^commit\s+(.+)$/) {
2257                                     $mergedhash = $1;
2258                                 } else {
2259                                     next;
2260                                 }
2261                             } else {
2262                                 # grab the first line that looks non-rfc822
2263                                 # aka has content after leading space
2264                                 if (m/^\s+(\S.*)$/) {
2265                                     my $title = $1;
2266                                     $title = substr($title,0,100); # truncate
2267                                     unshift @merged, "$mergedhash $title";
2268                                     undef $mergedhash;
2269                                 }
2270                             }
2271                         }
2272                         close GITLOG;
2273                         if (@merged) {
2274                             $commit->{mergemsg} = $commit->{message};
2275                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2276                             foreach my $summary (@merged) {
2277                                 $commit->{mergemsg} .= "\t$summary\n";
2278                             }
2279                             $commit->{mergemsg} .= "\n\n";
2280                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2281                         }
2282                     }
2283                 }
2284             }
2285         }
2286
2287         # convert the date to CVS-happy format
2288         $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2289
2290         if ( defined ( $lastpicked ) )
2291         {
2292             my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2293             while ( <FILELIST> )
2294             {
2295                 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 )
2296                 {
2297                     die("Couldn't process git-diff-tree line : $_");
2298                 }
2299
2300                 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2301
2302                 my $git_perms = "";
2303                 $git_perms .= "r" if ( $1 & 4 );
2304                 $git_perms .= "w" if ( $1 & 2 );
2305                 $git_perms .= "x" if ( $1 & 1 );
2306                 $git_perms = "rw" if ( $git_perms eq "" );
2307
2308                 if ( $3 eq "D" )
2309                 {
2310                     #$log->debug("DELETE   $4");
2311                     $head->{$4} = {
2312                         name => $4,
2313                         revision => $head->{$4}{revision} + 1,
2314                         filehash => "deleted",
2315                         commithash => $commit->{hash},
2316                         modified => $commit->{date},
2317                         author => $commit->{author},
2318                         mode => $git_perms,
2319                     };
2320                     $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2321                 }
2322                 elsif ( $3 eq "M" )
2323                 {
2324                     #$log->debug("MODIFIED $4");
2325                     $head->{$4} = {
2326                         name => $4,
2327                         revision => $head->{$4}{revision} + 1,
2328                         filehash => $2,
2329                         commithash => $commit->{hash},
2330                         modified => $commit->{date},
2331                         author => $commit->{author},
2332                         mode => $git_perms,
2333                     };
2334                     $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2335                 }
2336                 elsif ( $3 eq "A" )
2337                 {
2338                     #$log->debug("ADDED    $4");
2339                     $head->{$4} = {
2340                         name => $4,
2341                         revision => 1,
2342                         filehash => $2,
2343                         commithash => $commit->{hash},
2344                         modified => $commit->{date},
2345                         author => $commit->{author},
2346                         mode => $git_perms,
2347                     };
2348                     $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2349                 }
2350                 else
2351                 {
2352                     $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2353                     die;
2354                 }
2355             }
2356             close FILELIST;
2357         } else {
2358             # this is used to detect files removed from the repo
2359             my $seen_files = {};
2360
2361             my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2362             while ( <FILELIST> )
2363             {
2364                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2365                 {
2366                     die("Couldn't process git-ls-tree line : $_");
2367                 }
2368
2369                 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2370
2371                 $seen_files->{$git_filename} = 1;
2372
2373                 my ( $oldhash, $oldrevision, $oldmode ) = (
2374                     $head->{$git_filename}{filehash},
2375                     $head->{$git_filename}{revision},
2376                     $head->{$git_filename}{mode}
2377                 );
2378
2379                 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2380                 {
2381                     $git_perms = "";
2382                     $git_perms .= "r" if ( $1 & 4 );
2383                     $git_perms .= "w" if ( $1 & 2 );
2384                     $git_perms .= "x" if ( $1 & 1 );
2385                 } else {
2386                     $git_perms = "rw";
2387                 }
2388
2389                 # unless the file exists with the same hash, we need to update it ...
2390                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2391                 {
2392                     my $newrevision = ( $oldrevision or 0 ) + 1;
2393
2394                     $head->{$git_filename} = {
2395                         name => $git_filename,
2396                         revision => $newrevision,
2397                         filehash => $git_hash,
2398                         commithash => $commit->{hash},
2399                         modified => $commit->{date},
2400                         author => $commit->{author},
2401                         mode => $git_perms,
2402                     };
2403
2404
2405                     $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2406                 }
2407             }
2408             close FILELIST;
2409
2410             # Detect deleted files
2411             foreach my $file ( keys %$head )
2412             {
2413                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2414                 {
2415                     $head->{$file}{revision}++;
2416                     $head->{$file}{filehash} = "deleted";
2417                     $head->{$file}{commithash} = $commit->{hash};
2418                     $head->{$file}{modified} = $commit->{date};
2419                     $head->{$file}{author} = $commit->{author};
2420
2421                     $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2422                 }
2423             }
2424             # END : "Detect deleted files"
2425         }
2426
2427
2428         if (exists $commit->{mergemsg})
2429         {
2430             $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
2431         }
2432
2433         $lastpicked = $commit->{hash};
2434
2435         $self->_set_prop("last_commit", $commit->{hash});
2436     }
2437
2438     $self->delete_head();
2439     foreach my $file ( keys %$head )
2440     {
2441         $self->insert_head(
2442             $file,
2443             $head->{$file}{revision},
2444             $head->{$file}{filehash},
2445             $head->{$file}{commithash},
2446             $head->{$file}{modified},
2447             $head->{$file}{author},
2448             $head->{$file}{mode},
2449         );
2450     }
2451     # invalidate the gethead cache
2452     $self->{gethead_cache} = undef;
2453
2454
2455     # Ending exclusive lock here
2456     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2457 }
2458
2459 sub insert_rev
2460 {
2461     my $self = shift;
2462     my $name = shift;
2463     my $revision = shift;
2464     my $filehash = shift;
2465     my $commithash = shift;
2466     my $modified = shift;
2467     my $author = shift;
2468     my $mode = shift;
2469
2470     my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2471     $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2472 }
2473
2474 sub insert_mergelog
2475 {
2476     my $self = shift;
2477     my $key = shift;
2478     my $value = shift;
2479
2480     my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2481     $insert_mergelog->execute($key, $value);
2482 }
2483
2484 sub delete_head
2485 {
2486     my $self = shift;
2487
2488     my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2489     $delete_head->execute();
2490 }
2491
2492 sub insert_head
2493 {
2494     my $self = shift;
2495     my $name = shift;
2496     my $revision = shift;
2497     my $filehash = shift;
2498     my $commithash = shift;
2499     my $modified = shift;
2500     my $author = shift;
2501     my $mode = shift;
2502
2503     my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2504     $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2505 }
2506
2507 sub _headrev
2508 {
2509     my $self = shift;
2510     my $filename = shift;
2511
2512     my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2513     $db_query->execute($filename);
2514     my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2515
2516     return ( $hash, $revision, $mode );
2517 }
2518
2519 sub _get_prop
2520 {
2521     my $self = shift;
2522     my $key = shift;
2523
2524     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2525     $db_query->execute($key);
2526     my ( $value ) = $db_query->fetchrow_array;
2527
2528     return $value;
2529 }
2530
2531 sub _set_prop
2532 {
2533     my $self = shift;
2534     my $key = shift;
2535     my $value = shift;
2536
2537     my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2538     $db_query->execute($value, $key);
2539
2540     unless ( $db_query->rows )
2541     {
2542         $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2543         $db_query->execute($key, $value);
2544     }
2545
2546     return $value;
2547 }
2548
2549 =head2 gethead
2550
2551 =cut
2552
2553 sub gethead
2554 {
2555     my $self = shift;
2556
2557     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2558
2559     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2560     $db_query->execute();
2561
2562     my $tree = [];
2563     while ( my $file = $db_query->fetchrow_hashref )
2564     {
2565         push @$tree, $file;
2566     }
2567
2568     $self->{gethead_cache} = $tree;
2569
2570     return $tree;
2571 }
2572
2573 =head2 getlog
2574
2575 =cut
2576
2577 sub getlog
2578 {
2579     my $self = shift;
2580     my $filename = shift;
2581
2582     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2583     $db_query->execute($filename);
2584
2585     my $tree = [];
2586     while ( my $file = $db_query->fetchrow_hashref )
2587     {
2588         push @$tree, $file;
2589     }
2590
2591     return $tree;
2592 }
2593
2594 =head2 getmeta
2595
2596 This function takes a filename (with path) argument and returns a hashref of
2597 metadata for that file.
2598
2599 =cut
2600
2601 sub getmeta
2602 {
2603     my $self = shift;
2604     my $filename = shift;
2605     my $revision = shift;
2606
2607     my $db_query;
2608     if ( defined($revision) and $revision =~ /^\d+$/ )
2609     {
2610         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2611         $db_query->execute($filename, $revision);
2612     }
2613     elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2614     {
2615         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2616         $db_query->execute($filename, $revision);
2617     } else {
2618         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2619         $db_query->execute($filename);
2620     }
2621
2622     return $db_query->fetchrow_hashref;
2623 }
2624
2625 =head2 commitmessage
2626
2627 this function takes a commithash and returns the commit message for that commit
2628
2629 =cut
2630 sub commitmessage
2631 {
2632     my $self = shift;
2633     my $commithash = shift;
2634
2635     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2636
2637     my $db_query;
2638     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2639     $db_query->execute($commithash);
2640
2641     my ( $message ) = $db_query->fetchrow_array;
2642
2643     if ( defined ( $message ) )
2644     {
2645         $message .= " " if ( $message =~ /\n$/ );
2646         return $message;
2647     }
2648
2649     my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2650     shift @lines while ( $lines[0] =~ /\S/ );
2651     $message = join("",@lines);
2652     $message .= " " if ( $message =~ /\n$/ );
2653     return $message;
2654 }
2655
2656 =head2 gethistory
2657
2658 This function takes a filename (with path) argument and returns an arrayofarrays
2659 containing revision,filehash,commithash ordered by revision descending
2660
2661 =cut
2662 sub gethistory
2663 {
2664     my $self = shift;
2665     my $filename = shift;
2666
2667     my $db_query;
2668     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2669     $db_query->execute($filename);
2670
2671     return $db_query->fetchall_arrayref;
2672 }
2673
2674 =head2 gethistorydense
2675
2676 This function takes a filename (with path) argument and returns an arrayofarrays
2677 containing revision,filehash,commithash ordered by revision descending.
2678
2679 This version of gethistory skips deleted entries -- so it is useful for annotate.
2680 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2681 and other git tools that depend on it.
2682
2683 =cut
2684 sub gethistorydense
2685 {
2686     my $self = shift;
2687     my $filename = shift;
2688
2689     my $db_query;
2690     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2691     $db_query->execute($filename);
2692
2693     return $db_query->fetchall_arrayref;
2694 }
2695
2696 =head2 in_array()
2697
2698 from Array::PAT - mimics the in_array() function
2699 found in PHP. Yuck but works for small arrays.
2700
2701 =cut
2702 sub in_array
2703 {
2704     my ($check, @array) = @_;
2705     my $retval = 0;
2706     foreach my $test (@array){
2707         if($check eq $test){
2708             $retval =  1;
2709         }
2710     }
2711     return $retval;
2712 }
2713
2714 =head2 safe_pipe_capture
2715
2716 an alternative to `command` that allows input to be passed as an array
2717 to work around shell problems with weird characters in arguments
2718
2719 =cut
2720 sub safe_pipe_capture {
2721
2722     my @output;
2723
2724     if (my $pid = open my $child, '-|') {
2725         @output = (<$child>);
2726         close $child or die join(' ',@_).": $! $?";
2727     } else {
2728         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2729     }
2730     return wantarray ? @output : join('',@output);
2731 }
2732
2733
2734 1;