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     # Argumentx means: append to last Argument (with a newline in front)
 551
 552     $log->debug("$cmd : $data");
 553
 554     if ( $cmd eq 'Argumentx') {
 555         ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
 556     } else {
 557         push @{$state->{arguments}}, $data;
 558     }
 559 }
 560
 561 # expand-modules \n
 562 #     Response expected: yes. Expand the modules which are specified in the
 563 #     arguments. Returns the data in Module-expansion responses. Note that the
 564 #     server can assume that this is checkout or export, not rtag or rdiff; the
 565 #     latter do not access the working directory and thus have no need to
 566 #     expand modules on the client side. Expand may not be the best word for
 567 #     what this request does. It does not necessarily tell you all the files
 568 #     contained in a module, for example. Basically it is a way of telling you
 569 #     which working directories the server needs to know about in order to
 570 #     handle a checkout of the specified modules. For example, suppose that the
 571 #     server has a module defined by
 572 #   aliasmodule -a 1dir
 573 #     That is, one can check out aliasmodule and it will take 1dir in the
 574 #     repository and check it out to 1dir in the working directory. Now suppose
 575 #     the client already has this module checked out and is planning on using
 576 #     the co request to update it. Without using expand-modules, the client
 577 #     would have two bad choices: it could either send information about all
 578 #     working directories under the current directory, which could be
 579 #     unnecessarily slow, or it could be ignorant of the fact that aliasmodule
 580 #     stands for 1dir, and neglect to send information for 1dir, which would
 581 #     lead to incorrect operation. With expand-modules, the client would first
 582 #     ask for the module to be expanded:
 583 sub req_expandmodules
 584 {
 585     my ( $cmd, $data ) = @_;
 586
 587     argsplit();
 588
 589     $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
 590
 591     unless ( ref $state->{arguments} eq "ARRAY" )
 592     {
 593         print "ok\n";
 594         return;
 595     }
 596
 597     foreach my $module ( @{$state->{arguments}} )
 598     {
 599         $log->debug("SEND : Module-expansion $module");
 600         print "Module-expansion $module\n";
 601     }
 602
 603     print "ok\n";
 604     statecleanup();
 605 }
 606
 607 # co \n
 608 #     Response expected: yes. Get files from the repository. This uses any
 609 #     previous Argument, Directory, Entry, or Modified requests, if they have
 610 #     been sent. Arguments to this command are module names; the client cannot
 611 #     know what directories they correspond to except by (1) just sending the
 612 #     co request, and then seeing what directory names the server sends back in
 613 #     its responses, and (2) the expand-modules request.
 614 sub req_co
 615 {
 616     my ( $cmd, $data ) = @_;
 617
 618     argsplit("co");
 619
 620     my $module = $state->{args}[0];
 621     my $checkout_path = $module;
 622
 623     # use the user specified directory if we're given it
 624     $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
 625
 626     $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
 627
 628     $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
 629
 630     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 631
 632     # Grab a handle to the SQLite db and do any necessary updates
 633     my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
 634     $updater->update();
 635
 636     $checkout_path =~ s|/$||; # get rid of trailing slashes
 637
 638     # Eclipse seems to need the Clear-sticky command
 639     # to prepare the 'Entries' file for the new directory.
 640     print "Clear-sticky $checkout_path/\n";
 641     print $state->{CVSROOT} . "/$module/\n";
 642     print "Clear-static-directory $checkout_path/\n";
 643     print $state->{CVSROOT} . "/$module/\n";
 644     print "Clear-sticky $checkout_path/\n"; # yes, twice
 645     print $state->{CVSROOT} . "/$module/\n";
 646     print "Template $checkout_path/\n";
 647     print $state->{CVSROOT} . "/$module/\n";
 648     print "0\n";
 649
 650     # instruct the client that we're checking out to $checkout_path
 651     print "E cvs checkout: Updating $checkout_path\n";
 652
 653     my %seendirs = ();
 654     my $lastdir ='';
 655
 656     # recursive
 657     sub prepdir {
 658        my ($dir, $repodir, $remotedir, $seendirs) = @_;
 659        my $parent = dirname($dir);
 660        $dir       =~ s|/+$||;
 661        $repodir   =~ s|/+$||;
 662        $remotedir =~ s|/+$||;
 663        $parent    =~ s|/+$||;
 664        $log->debug("announcedir $dir, $repodir, $remotedir" );
 665
 666        if ($parent eq '.' || $parent eq './') {
 667            $parent = '';
 668        }
 669        # recurse to announce unseen parents first
 670        if (length($parent) && !exists($seendirs->{$parent})) {
 671            prepdir($parent, $repodir, $remotedir, $seendirs);
 672        }
 673        # Announce that we are going to modify at the parent level
 674        if ($parent) {
 675            print "E cvs checkout: Updating $remotedir/$parent\n";
 676        } else {
 677            print "E cvs checkout: Updating $remotedir\n";
 678        }
 679        print "Clear-sticky $remotedir/$parent/\n";
 680        print "$repodir/$parent/\n";
 681
 682        print "Clear-static-directory $remotedir/$dir/\n";
 683        print "$repodir/$dir/\n";
 684        print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
 685        print "$repodir/$parent/\n";
 686        print "Template $remotedir/$dir/\n";
 687        print "$repodir/$dir/\n";
 688        print "0\n";
 689
 690        $seendirs->{$dir} = 1;
 691     }
 692
 693     foreach my $git ( @{$updater->gethead} )
 694     {
 695         # Don't want to check out deleted files
 696         next if ( $git->{filehash} eq "deleted" );
 697
 698         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
 699
 700        if (length($git->{dir}) && $git->{dir} ne './'
 701            && $git->{dir} ne $lastdir ) {
 702            unless (exists($seendirs{$git->{dir}})) {
 703                prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
 704                        $checkout_path, \%seendirs);
 705                $lastdir = $git->{dir};
 706                $seendirs{$git->{dir}} = 1;
 707            }
 708            print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
 709        }
 710
 711         # modification time of this file
 712         print "Mod-time $git->{modified}\n";
 713
 714         # print some information to the client
 715         if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
 716         {
 717             print "M U $checkout_path/$git->{dir}$git->{name}\n";
 718         } else {
 719             print "M U $checkout_path/$git->{name}\n";
 720         }
 721
 722        # instruct client we're sending a file to put in this path
 723        print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
 724
 725        print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
 726
 727         # this is an "entries" line
 728         print "/$git->{name}/1.$git->{revision}///\n";
 729         # permissions
 730         print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
 731
 732         # transmit file
 733         transmitfile($git->{filehash});
 734     }
 735
 736     print "ok\n";
 737
 738     statecleanup();
 739 }
 740
 741 # update \n
 742 #     Response expected: yes. Actually do a cvs update command. This uses any
 743 #     previous Argument, Directory, Entry, or Modified requests, if they have
 744 #     been sent. The last Directory sent specifies the working directory at the
 745 #     time of the operation. The -I option is not used--files which the client
 746 #     can decide whether to ignore are not mentioned and the client sends the
 747 #     Questionable request for others.
 748 sub req_update
 749 {
 750     my ( $cmd, $data ) = @_;
 751
 752     $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
 753
 754     argsplit("update");
 755
 756     #
 757     # It may just be a client exploring the available heads/modules
 758     # in that case, list them as top level directories and leave it
 759     # at that. Eclipse uses this technique to offer you a list of
 760     # projects (heads in this case) to checkout.
 761     #
 762     if ($state->{module} eq '') {
 763         print "E cvs update: Updating .\n";
 764         opendir HEADS, $state->{CVSROOT} . '/refs/heads';
 765         while (my $head = readdir(HEADS)) {
 766             if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
 767                 print "E cvs update: New directory `$head'\n";
 768             }
 769         }
 770         closedir HEADS;
 771         print "ok\n";
 772         return 1;
 773     }
 774
 775
 776     # Grab a handle to the SQLite db and do any necessary updates
 777     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 778
 779     $updater->update();
 780
 781     argsfromdir($updater);
 782
 783     #$log->debug("update state : " . Dumper($state));
 784
 785     # foreach file specified on the command line ...
 786     foreach my $filename ( @{$state->{args}} )
 787     {
 788         $filename = filecleanup($filename);
 789
 790         $log->debug("Processing file $filename");
 791
 792         # if we have a -C we should pretend we never saw modified stuff
 793         if ( exists ( $state->{opt}{C} ) )
 794         {
 795             delete $state->{entries}{$filename}{modified_hash};
 796             delete $state->{entries}{$filename}{modified_filename};
 797             $state->{entries}{$filename}{unchanged} = 1;
 798         }
 799
 800         my $meta;
 801         if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
 802         {
 803             $meta = $updater->getmeta($filename, $1);
 804         } else {
 805             $meta = $updater->getmeta($filename);
 806         }
 807
 808         next unless ( $meta->{revision} );
 809
 810         my $oldmeta = $meta;
 811
 812         my $wrev = revparse($filename);
 813
 814         # If the working copy is an old revision, lets get that version too for comparison.
 815         if ( defined($wrev) and $wrev != $meta->{revision} )
 816         {
 817             $oldmeta = $updater->getmeta($filename, $wrev);
 818         }
 819
 820         #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
 821
 822         # Files are up to date if the working copy and repo copy have the same revision,
 823         # and the working copy is unmodified _and_ the user hasn't specified -C
 824         next if ( defined ( $wrev )
 825                   and defined($meta->{revision})
 826                   and $wrev == $meta->{revision}
 827                   and $state->{entries}{$filename}{unchanged}
 828                   and not exists ( $state->{opt}{C} ) );
 829
 830         # If the working copy and repo copy have the same revision,
 831         # but the working copy is modified, tell the client it's modified
 832         if ( defined ( $wrev )
 833              and defined($meta->{revision})
 834              and $wrev == $meta->{revision}
 835              and not exists ( $state->{opt}{C} ) )
 836         {
 837             $log->info("Tell the client the file is modified");
 838             print "MT text U\n";
 839             print "MT fname $filename\n";
 840             print "MT newline\n";
 841             next;
 842         }
 843
 844         if ( $meta->{filehash} eq "deleted" )
 845         {
 846             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 847
 848             $log->info("Removing '$filename' from working copy (no longer in the repo)");
 849
 850             print "E cvs update: `$filename' is no longer in the repository\n";
 851             # Don't want to actually _DO_ the update if -n specified
 852             unless ( $state->{globaloptions}{-n} ) {
 853                 print "Removed $dirpart\n";
 854                 print "$filepart\n";
 855             }
 856         }
 857         elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
 858                 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} )
 859         {
 860             $log->info("Updating '$filename'");
 861             # normal update, just send the new revision (either U=Update, or A=Add, or R=Remove)
 862             print "MT +updated\n";
 863             print "MT text U\n";
 864             print "MT fname $filename\n";
 865             print "MT newline\n";
 866             print "MT -updated\n";
 867
 868             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 869
 870             # Don't want to actually _DO_ the update if -n specified
 871             unless ( $state->{globaloptions}{-n} )
 872             {
 873                 if ( defined ( $wrev ) )
 874                 {
 875                     # instruct client we're sending a file to put in this path as a replacement
 876                     print "Update-existing $dirpart\n";
 877                     $log->debug("Updating existing file 'Update-existing $dirpart'");
 878                 } else {
 879                     # instruct client we're sending a file to put in this path as a new file
 880                     print "Clear-static-directory $dirpart\n";
 881                     print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
 882                     print "Clear-sticky $dirpart\n";
 883                     print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
 884
 885                     $log->debug("Creating new file 'Created $dirpart'");
 886                     print "Created $dirpart\n";
 887                 }
 888                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 889
 890                 # this is an "entries" line
 891                 $log->debug("/$filepart/1.$meta->{revision}///");
 892                 print "/$filepart/1.$meta->{revision}///\n";
 893
 894                 # permissions
 895                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 896                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 897
 898                 # transmit file
 899                 transmitfile($meta->{filehash});
 900             }
 901         } else {
 902             $log->info("Updating '$filename'");
 903             my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
 904
 905             my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
 906
 907             chdir $dir;
 908             my $file_local = $filepart . ".mine";
 909             system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
 910             my $file_old = $filepart . "." . $oldmeta->{revision};
 911             transmitfile($oldmeta->{filehash}, $file_old);
 912             my $file_new = $filepart . "." . $meta->{revision};
 913             transmitfile($meta->{filehash}, $file_new);
 914
 915             # we need to merge with the local changes ( M=successful merge, C=conflict merge )
 916             $log->info("Merging $file_local, $file_old, $file_new");
 917
 918             $log->debug("Temporary directory for merge is $dir");
 919
 920             my $return = system("merge", $file_local, $file_old, $file_new);
 921             $return >>= 8;
 922
 923             if ( $return == 0 )
 924             {
 925                 $log->info("Merged successfully");
 926                 print "M M $filename\n";
 927                 $log->debug("Update-existing $dirpart");
 928
 929                 # Don't want to actually _DO_ the update if -n specified
 930                 unless ( $state->{globaloptions}{-n} )
 931                 {
 932                     print "Update-existing $dirpart\n";
 933                     $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
 934                     print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 935                     $log->debug("/$filepart/1.$meta->{revision}///");
 936                     print "/$filepart/1.$meta->{revision}///\n";
 937                 }
 938             }
 939             elsif ( $return == 1 )
 940             {
 941                 $log->info("Merged with conflicts");
 942                 print "M C $filename\n";
 943
 944                 # Don't want to actually _DO_ the update if -n specified
 945                 unless ( $state->{globaloptions}{-n} )
 946                 {
 947                     print "Update-existing $dirpart\n";
 948                     print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 949                     print "/$filepart/1.$meta->{revision}/+//\n";
 950                 }
 951             }
 952             else
 953             {
 954                 $log->warn("Merge failed");
 955                 next;
 956             }
 957
 958             # Don't want to actually _DO_ the update if -n specified
 959             unless ( $state->{globaloptions}{-n} )
 960             {
 961                 # permissions
 962                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 963                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 964
 965                 # transmit file, format is single integer on a line by itself (file
 966                 # size) followed by the file contents
 967                 # TODO : we should copy files in blocks
 968                 my $data = `cat $file_local`;
 969                 $log->debug("File size : " . length($data));
 970                 print length($data) . "\n";
 971                 print $data;
 972             }
 973
 974             chdir "/";
 975         }
 976
 977     }
 978
 979     print "ok\n";
 980 }
 981
 982 sub req_ci
 983 {
 984     my ( $cmd, $data ) = @_;
 985
 986     argsplit("ci");
 987
 988     #$log->debug("State : " . Dumper($state));
 989
 990     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
 991
 992     if ( @ARGV && $ARGV[0] eq 'pserver')
 993     {
 994         print "error 1 pserver access cannot commit\n";
 995         exit;
 996     }
 997
 998     if ( -e $state->{CVSROOT} . "/index" )
 999     {
1000         $log->warn("file 'index' already exists in the git repository");
1001         print "error 1 Index already exists in git repo\n";
1002         exit;
1003     }
1004
1005     my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
1006     unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )
1007     {
1008         $log->warn("lockfile '$lockfile' already exists, please try again");
1009         print "error 1 Lock file '$lockfile' already exists, please try again\n";
1010         exit;
1011     }
1012
1013     # Grab a handle to the SQLite db and do any necessary updates
1014     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1015     $updater->update();
1016
1017     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1018     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1019     $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
1020
1021     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1022     $ENV{GIT_INDEX_FILE} = $file_index;
1023
1024     chdir $tmpdir;
1025
1026     # populate the temporary index based
1027     system("git-read-tree", $state->{module});
1028     unless ($? == 0)
1029     {
1030         die "Error running git-read-tree $state->{module} $file_index $!";
1031     }
1032     $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
1033
1034
1035     my @committedfiles = ();
1036
1037     # foreach file specified on the command line ...
1038     foreach my $filename ( @{$state->{args}} )
1039     {
1040         my $committedfile = $filename;
1041         $filename = filecleanup($filename);
1042
1043         next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1044
1045         my $meta = $updater->getmeta($filename);
1046
1047         my $wrev = revparse($filename);
1048
1049         my ( $filepart, $dirpart ) = filenamesplit($filename);
1050
1051         # do a checkout of the file if it part of this tree
1052         if ($wrev) {
1053             system('git-checkout-index', '-f', '-u', $filename);
1054             unless ($? == 0) {
1055                 die "Error running git-checkout-index -f -u $filename : $!";
1056             }
1057         }
1058
1059         my $addflag = 0;
1060         my $rmflag = 0;
1061         $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1062         $addflag = 1 unless ( -e $filename );
1063
1064         # Do up to date checking
1065         unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1066         {
1067             # fail everything if an up to date check fails
1068             print "error 1 Up to date check failed for $filename\n";
1069             close LOCKFILE;
1070             unlink($lockfile);
1071             chdir "/";
1072             exit;
1073         }
1074
1075         push @committedfiles, $committedfile;
1076         $log->info("Committing $filename");
1077
1078         system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1079
1080         unless ( $rmflag )
1081         {
1082             $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1083             rename $state->{entries}{$filename}{modified_filename},$filename;
1084
1085             # Calculate modes to remove
1086             my $invmode = "";
1087             foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1088
1089             $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1090             system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1091         }
1092
1093         if ( $rmflag )
1094         {
1095             $log->info("Removing file '$filename'");
1096             unlink($filename);
1097             system("git-update-index", "--remove", $filename);
1098         }
1099         elsif ( $addflag )
1100         {
1101             $log->info("Adding file '$filename'");
1102             system("git-update-index", "--add", $filename);
1103         } else {
1104             $log->info("Updating file '$filename'");
1105             system("git-update-index", $filename);
1106         }
1107     }
1108
1109     unless ( scalar(@committedfiles) > 0 )
1110     {
1111         print "E No files to commit\n";
1112         print "ok\n";
1113         close LOCKFILE;
1114         unlink($lockfile);
1115         chdir "/";
1116         return;
1117     }
1118
1119     my $treehash = `git-write-tree`;
1120     my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
1121     chomp $treehash;
1122     chomp $parenthash;
1123
1124     $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1125
1126     # write our commit message out if we have one ...
1127     my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1128     print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1129     print $msg_fh "\n\nvia git-CVS emulator\n";
1130     close $msg_fh;
1131
1132     my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1133     $log->info("Commit hash : $commithash");
1134
1135     unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1136     {
1137         $log->warn("Commit failed (Invalid commit hash)");
1138         print "error 1 Commit failed (unknown reason)\n";
1139         close LOCKFILE;
1140         unlink($lockfile);
1141         chdir "/";
1142         exit;
1143     }
1144
1145     print LOCKFILE $commithash;
1146
1147     $updater->update();
1148
1149     # foreach file specified on the command line ...
1150     foreach my $filename ( @committedfiles )
1151     {
1152         $filename = filecleanup($filename);
1153
1154         my $meta = $updater->getmeta($filename);
1155
1156         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
1157
1158         $log->debug("Checked-in $dirpart : $filename");
1159
1160         if ( $meta->{filehash} eq "deleted" )
1161         {
1162             print "Remove-entry $dirpart\n";
1163             print "$filename\n";
1164         } else {
1165             print "Checked-in $dirpart\n";
1166             print "$filename\n";
1167             print "/$filepart/1.$meta->{revision}///\n";
1168         }
1169     }
1170
1171     close LOCKFILE;
1172     my $reffile = "$ENV{GIT_DIR}refs/heads/$state->{module}";
1173     unlink($reffile);
1174     rename($lockfile, $reffile);
1175     chdir "/";
1176
1177     print "ok\n";
1178 }
1179
1180 sub req_status
1181 {
1182     my ( $cmd, $data ) = @_;
1183
1184     argsplit("status");
1185
1186     $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1187     #$log->debug("status state : " . Dumper($state));
1188
1189     # Grab a handle to the SQLite db and do any necessary updates
1190     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1191     $updater->update();
1192
1193     # if no files were specified, we need to work out what files we should be providing status on ...
1194     argsfromdir($updater);
1195
1196     # foreach file specified on the command line ...
1197     foreach my $filename ( @{$state->{args}} )
1198     {
1199         $filename = filecleanup($filename);
1200
1201         my $meta = $updater->getmeta($filename);
1202         my $oldmeta = $meta;
1203
1204         my $wrev = revparse($filename);
1205
1206         # If the working copy is an old revision, lets get that version too for comparison.
1207         if ( defined($wrev) and $wrev != $meta->{revision} )
1208         {
1209             $oldmeta = $updater->getmeta($filename, $wrev);
1210         }
1211
1212         # TODO : All possible statuses aren't yet implemented
1213         my $status;
1214         # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1215         $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1216                                     and
1217                                     ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1218                                       or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1219                                    );
1220
1221         # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1222         $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1223                                           and
1224                                           ( $state->{entries}{$filename}{unchanged}
1225                                             or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1226                                         );
1227
1228         # Need checkout if it exists in the repo but doesn't have a working copy
1229         $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1230
1231         # Locally modified if working copy and repo copy have the same revision but there are local changes
1232         $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1233
1234         # Needs Merge if working copy revision is less than repo copy and there are local changes
1235         $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1236
1237         $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1238         $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1239         $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1240         $status ||= "File had conflicts on merge" if ( 0 );
1241
1242         $status ||= "Unknown";
1243
1244         print "M ===================================================================\n";
1245         print "M File: $filename\tStatus: $status\n";
1246         if ( defined($state->{entries}{$filename}{revision}) )
1247         {
1248             print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1249         } else {
1250             print "M Working revision:\tNo entry for $filename\n";
1251         }
1252         if ( defined($meta->{revision}) )
1253         {
1254             print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1255             print "M Sticky Tag:\t\t(none)\n";
1256             print "M Sticky Date:\t\t(none)\n";
1257             print "M Sticky Options:\t\t(none)\n";
1258         } else {
1259             print "M Repository revision:\tNo revision control file\n";
1260         }
1261         print "M\n";
1262     }
1263
1264     print "ok\n";
1265 }
1266
1267 sub req_diff
1268 {
1269     my ( $cmd, $data ) = @_;
1270
1271     argsplit("diff");
1272
1273     $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1274     #$log->debug("status state : " . Dumper($state));
1275
1276     my ($revision1, $revision2);
1277     if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1278     {
1279         $revision1 = $state->{opt}{r}[0];
1280         $revision2 = $state->{opt}{r}[1];
1281     } else {
1282         $revision1 = $state->{opt}{r};
1283     }
1284
1285     $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1286     $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1287
1288     $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1289
1290     # Grab a handle to the SQLite db and do any necessary updates
1291     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1292     $updater->update();
1293
1294     # if no files were specified, we need to work out what files we should be providing status on ...
1295     argsfromdir($updater);
1296
1297     # foreach file specified on the command line ...
1298     foreach my $filename ( @{$state->{args}} )
1299     {
1300         $filename = filecleanup($filename);
1301
1302         my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1303
1304         my $wrev = revparse($filename);
1305
1306         # We need _something_ to diff against
1307         next unless ( defined ( $wrev ) );
1308
1309         # if we have a -r switch, use it
1310         if ( defined ( $revision1 ) )
1311         {
1312             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1313             $meta1 = $updater->getmeta($filename, $revision1);
1314             unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1315             {
1316                 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1317                 next;
1318             }
1319             transmitfile($meta1->{filehash}, $file1);
1320         }
1321         # otherwise we just use the working copy revision
1322         else
1323         {
1324             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1325             $meta1 = $updater->getmeta($filename, $wrev);
1326             transmitfile($meta1->{filehash}, $file1);
1327         }
1328
1329         # if we have a second -r switch, use it too
1330         if ( defined ( $revision2 ) )
1331         {
1332             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1333             $meta2 = $updater->getmeta($filename, $revision2);
1334
1335             unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1336             {
1337                 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1338                 next;
1339             }
1340
1341             transmitfile($meta2->{filehash}, $file2);
1342         }
1343         # otherwise we just use the working copy
1344         else
1345         {
1346             $file2 = $state->{entries}{$filename}{modified_filename};
1347         }
1348
1349         # if we have been given -r, and we don't have a $file2 yet, lets get one
1350         if ( defined ( $revision1 ) and not defined ( $file2 ) )
1351         {
1352             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1353             $meta2 = $updater->getmeta($filename, $wrev);
1354             transmitfile($meta2->{filehash}, $file2);
1355         }
1356
1357         # We need to have retrieved something useful
1358         next unless ( defined ( $meta1 ) );
1359
1360         # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1361         next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1362                   and
1363                    ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1364                      or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1365                   );
1366
1367         # Apparently we only show diffs for locally modified files
1368         next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1369
1370         print "M Index: $filename\n";
1371         print "M ===================================================================\n";
1372         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1373         print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1374         print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1375         print "M diff ";
1376         foreach my $opt ( keys %{$state->{opt}} )
1377         {
1378             if ( ref $state->{opt}{$opt} eq "ARRAY" )
1379             {
1380                 foreach my $value ( @{$state->{opt}{$opt}} )
1381                 {
1382                     print "-$opt $value ";
1383                 }
1384             } else {
1385                 print "-$opt ";
1386                 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1387             }
1388         }
1389         print "$filename\n";
1390
1391         $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1392
1393         ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1394
1395         if ( exists $state->{opt}{u} )
1396         {
1397             system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1398         } else {
1399             system("diff $file1 $file2 > $filediff");
1400         }
1401
1402         while ( <$fh> )
1403         {
1404             print "M $_";
1405         }
1406         close $fh;
1407     }
1408
1409     print "ok\n";
1410 }
1411
1412 sub req_log
1413 {
1414     my ( $cmd, $data ) = @_;
1415
1416     argsplit("log");
1417
1418     $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1419     #$log->debug("log state : " . Dumper($state));
1420
1421     my ( $minrev, $maxrev );
1422     if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1423     {
1424         my $control = $2;
1425         $minrev = $1;
1426         $maxrev = $3;
1427         $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1428         $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1429         $minrev++ if ( defined($minrev) and $control eq "::" );
1430     }
1431
1432     # Grab a handle to the SQLite db and do any necessary updates
1433     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1434     $updater->update();
1435
1436     # if no files were specified, we need to work out what files we should be providing status on ...
1437     argsfromdir($updater);
1438
1439     # foreach file specified on the command line ...
1440     foreach my $filename ( @{$state->{args}} )
1441     {
1442         $filename = filecleanup($filename);
1443
1444         my $headmeta = $updater->getmeta($filename);
1445
1446         my $revisions = $updater->getlog($filename);
1447         my $totalrevisions = scalar(@$revisions);
1448
1449         if ( defined ( $minrev ) )
1450         {
1451             $log->debug("Removing revisions less than $minrev");
1452             while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1453             {
1454                 pop @$revisions;
1455             }
1456         }
1457         if ( defined ( $maxrev ) )
1458         {
1459             $log->debug("Removing revisions greater than $maxrev");
1460             while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1461             {
1462                 shift @$revisions;
1463             }
1464         }
1465
1466         next unless ( scalar(@$revisions) );
1467
1468         print "M \n";
1469         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1470         print "M Working file: $filename\n";
1471         print "M head: 1.$headmeta->{revision}\n";
1472         print "M branch:\n";
1473         print "M locks: strict\n";
1474         print "M access list:\n";
1475         print "M symbolic names:\n";
1476         print "M keyword substitution: kv\n";
1477         print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1478         print "M description:\n";
1479
1480         foreach my $revision ( @$revisions )
1481         {
1482             print "M ----------------------------\n";
1483             print "M revision 1.$revision->{revision}\n";
1484             # reformat the date for log output
1485             $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}) );
1486             $revision->{author} =~ s/\s+.*//;
1487             $revision->{author} =~ s/^(.{8}).*/$1/;
1488             print "M date: $revision->{modified};  author: $revision->{author};  state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . ";  lines: +2 -3\n";
1489             my $commitmessage = $updater->commitmessage($revision->{commithash});
1490             $commitmessage =~ s/^/M /mg;
1491             print $commitmessage . "\n";
1492         }
1493         print "M =============================================================================\n";
1494     }
1495
1496     print "ok\n";
1497 }
1498
1499 sub req_annotate
1500 {
1501     my ( $cmd, $data ) = @_;
1502
1503     argsplit("annotate");
1504
1505     $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1506     #$log->debug("status state : " . Dumper($state));
1507
1508     # Grab a handle to the SQLite db and do any necessary updates
1509     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1510     $updater->update();
1511
1512     # if no files were specified, we need to work out what files we should be providing annotate on ...
1513     argsfromdir($updater);
1514
1515     # we'll need a temporary checkout dir
1516     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1517     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1518     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1519
1520     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1521     $ENV{GIT_INDEX_FILE} = $file_index;
1522
1523     chdir $tmpdir;
1524
1525     # foreach file specified on the command line ...
1526     foreach my $filename ( @{$state->{args}} )
1527     {
1528         $filename = filecleanup($filename);
1529
1530         my $meta = $updater->getmeta($filename);
1531
1532         next unless ( $meta->{revision} );
1533
1534         # get all the commits that this file was in
1535         # in dense format -- aka skip dead revisions
1536         my $revisions   = $updater->gethistorydense($filename);
1537         my $lastseenin  = $revisions->[0][2];
1538
1539         # populate the temporary index based on the latest commit were we saw
1540         # the file -- but do it cheaply without checking out any files
1541         # TODO: if we got a revision from the client, use that instead
1542         # to look up the commithash in sqlite (still good to default to
1543         # the current head as we do now)
1544         system("git-read-tree", $lastseenin);
1545         unless ($? == 0)
1546         {
1547             die "Error running git-read-tree $lastseenin $file_index $!";
1548         }
1549         $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1550
1551         # do a checkout of the file
1552         system('git-checkout-index', '-f', '-u', $filename);
1553         unless ($? == 0) {
1554             die "Error running git-checkout-index -f -u $filename : $!";
1555         }
1556
1557         $log->info("Annotate $filename");
1558
1559         # Prepare a file with the commits from the linearized
1560         # history that annotate should know about. This prevents
1561         # git-jsannotate telling us about commits we are hiding
1562         # from the client.
1563
1564         open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1565         for (my $i=0; $i < @$revisions; $i++)
1566         {
1567             print ANNOTATEHINTS $revisions->[$i][2];
1568             if ($i+1 < @$revisions) { # have we got a parent?
1569                 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1570             }
1571             print ANNOTATEHINTS "\n";
1572         }
1573
1574         print ANNOTATEHINTS "\n";
1575         close ANNOTATEHINTS;
1576
1577         my $annotatecmd = 'git-annotate';
1578         open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1579             or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1580         my $metadata = {};
1581         print "E Annotations for $filename\n";
1582         print "E ***************\n";
1583         while ( <ANNOTATE> )
1584         {
1585             if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1586             {
1587                 my $commithash = $1;
1588                 my $data = $2;
1589                 unless ( defined ( $metadata->{$commithash} ) )
1590                 {
1591                     $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1592                     $metadata->{$commithash}{author} =~ s/\s+.*//;
1593                     $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1594                     $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1595                 }
1596                 printf("M 1.%-5d      (%-8s %10s): %s\n",
1597                     $metadata->{$commithash}{revision},
1598                     $metadata->{$commithash}{author},
1599                     $metadata->{$commithash}{modified},
1600                     $data
1601                 );
1602             } else {
1603                 $log->warn("Error in annotate output! LINE: $_");
1604                 print "E Annotate error \n";
1605                 next;
1606             }
1607         }
1608         close ANNOTATE;
1609     }
1610
1611     # done; get out of the tempdir
1612     chdir "/";
1613
1614     print "ok\n";
1615
1616 }
1617
1618 # This method takes the state->{arguments} array and produces two new arrays.
1619 # The first is $state->{args} which is everything before the '--' argument, and
1620 # the second is $state->{files} which is everything after it.
1621 sub argsplit
1622 {
1623     return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1624
1625     my $type = shift;
1626
1627     $state->{args} = [];
1628     $state->{files} = [];
1629     $state->{opt} = {};
1630
1631     if ( defined($type) )
1632     {
1633         my $opt = {};
1634         $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" );
1635         $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1636         $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" );
1637         $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1638         $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1639         $opt = { k => 1, m => 1 } if ( $type eq "add" );
1640         $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1641         $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" );
1642
1643
1644         while ( scalar ( @{$state->{arguments}} ) > 0 )
1645         {
1646             my $arg = shift @{$state->{arguments}};
1647
1648             next if ( $arg eq "--" );
1649             next unless ( $arg =~ /\S/ );
1650
1651             # if the argument looks like a switch
1652             if ( $arg =~ /^-(\w)(.*)/ )
1653             {
1654                 # if it's a switch that takes an argument
1655                 if ( $opt->{$1} )
1656                 {
1657                     # If this switch has already been provided
1658                     if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1659                     {
1660                         $state->{opt}{$1} = [ $state->{opt}{$1} ];
1661                         if ( length($2) > 0 )
1662                         {
1663                             push @{$state->{opt}{$1}},$2;
1664                         } else {
1665                             push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1666                         }
1667                     } else {
1668                         # if there's extra data in the arg, use that as the argument for the switch
1669                         if ( length($2) > 0 )
1670                         {
1671                             $state->{opt}{$1} = $2;
1672                         } else {
1673                             $state->{opt}{$1} = shift @{$state->{arguments}};
1674                         }
1675                     }
1676                 } else {
1677                     $state->{opt}{$1} = undef;
1678                 }
1679             }
1680             else
1681             {
1682                 push @{$state->{args}}, $arg;
1683             }
1684         }
1685     }
1686     else
1687     {
1688         my $mode = 0;
1689
1690         foreach my $value ( @{$state->{arguments}} )
1691         {
1692             if ( $value eq "--" )
1693             {
1694                 $mode++;
1695                 next;
1696             }
1697             push @{$state->{args}}, $value if ( $mode == 0 );
1698             push @{$state->{files}}, $value if ( $mode == 1 );
1699         }
1700     }
1701 }
1702
1703 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1704 sub argsfromdir
1705 {
1706     my $updater = shift;
1707
1708     $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
1709
1710     return if ( scalar ( @{$state->{args}} ) > 1 );
1711
1712     if ( scalar(@{$state->{args}}) == 1 )
1713     {
1714         my $arg = $state->{args}[0];
1715         $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
1716
1717         $log->info("Only one arg specified, checking for directory expansion on '$arg'");
1718
1719         foreach my $file ( @{$updater->gethead} )
1720         {
1721             next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1722             next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg  );
1723             push @{$state->{args}}, $file->{name};
1724         }
1725
1726         shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
1727     } else {
1728         $log->info("Only one arg specified, populating file list automatically");
1729
1730         $state->{args} = [];
1731
1732         foreach my $file ( @{$updater->gethead} )
1733         {
1734             next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1735             next unless ( $file->{name} =~ s/^$state->{prependdir}// );
1736             push @{$state->{args}}, $file->{name};
1737         }
1738     }
1739 }
1740
1741 # This method cleans up the $state variable after a command that uses arguments has run
1742 sub statecleanup
1743 {
1744     $state->{files} = [];
1745     $state->{args} = [];
1746     $state->{arguments} = [];
1747     $state->{entries} = {};
1748 }
1749
1750 sub revparse
1751 {
1752     my $filename = shift;
1753
1754     return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1755
1756     return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1757     return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1758
1759     return undef;
1760 }
1761
1762 # This method takes a file hash and does a CVS "file transfer" which transmits the
1763 # size of the file, and then the file contents.
1764 # If a second argument $targetfile is given, the file is instead written out to
1765 # a file by the name of $targetfile
1766 sub transmitfile
1767 {
1768     my $filehash = shift;
1769     my $targetfile = shift;
1770
1771     if ( defined ( $filehash ) and $filehash eq "deleted" )
1772     {
1773         $log->warn("filehash is 'deleted'");
1774         return;
1775     }
1776
1777     die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1778
1779     my $type = `git-cat-file -t $filehash`;
1780     chomp $type;
1781
1782     die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1783
1784     my $size = `git-cat-file -s $filehash`;
1785     chomp $size;
1786
1787     $log->debug("transmitfile($filehash) size=$size, type=$type");
1788
1789     if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1790     {
1791         if ( defined ( $targetfile ) )
1792         {
1793             open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1794             print NEWFILE $_ while ( <$fh> );
1795             close NEWFILE;
1796         } else {
1797             print "$size\n";
1798             print while ( <$fh> );
1799         }
1800         close $fh or die ("Couldn't close filehandle for transmitfile()");
1801     } else {
1802         die("Couldn't execute git-cat-file");
1803     }
1804 }
1805
1806 # This method takes a file name, and returns ( $dirpart, $filepart ) which
1807 # refers to the directory portion and the file portion of the filename
1808 # respectively
1809 sub filenamesplit
1810 {
1811     my $filename = shift;
1812     my $fixforlocaldir = shift;
1813
1814     my ( $filepart, $dirpart ) = ( $filename, "." );
1815     ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1816     $dirpart .= "/";
1817
1818     if ( $fixforlocaldir )
1819     {
1820         $dirpart =~ s/^$state->{prependdir}//;
1821     }
1822
1823     return ( $filepart, $dirpart );
1824 }
1825
1826 sub filecleanup
1827 {
1828     my $filename = shift;
1829
1830     return undef unless(defined($filename));
1831     if ( $filename =~ /^\// )
1832     {
1833         print "E absolute filenames '$filename' not supported by server\n";
1834         return undef;
1835     }
1836
1837     $filename =~ s/^\.\///g;
1838     $filename = $state->{prependdir} . $filename;
1839     return $filename;
1840 }
1841
1842 package GITCVS::log;
1843
1844 ####
1845 #### Copyright The Open University UK - 2006.
1846 ####
1847 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1848 ####          Martin Langhoff <martin@catalyst.net.nz>
1849 ####
1850 ####
1851
1852 use strict;
1853 use warnings;
1854
1855 =head1 NAME
1856
1857 GITCVS::log
1858
1859 =head1 DESCRIPTION
1860
1861 This module provides very crude logging with a similar interface to
1862 Log::Log4perl
1863
1864 =head1 METHODS
1865
1866 =cut
1867
1868 =head2 new
1869
1870 Creates a new log object, optionally you can specify a filename here to
1871 indicate the file to log to. If no log file is specified, you can specify one
1872 later with method setfile, or indicate you no longer want logging with method
1873 nofile.
1874
1875 Until one of these methods is called, all log calls will buffer messages ready
1876 to write out.
1877
1878 =cut
1879 sub new
1880 {
1881     my $class = shift;
1882     my $filename = shift;
1883
1884     my $self = {};
1885
1886     bless $self, $class;
1887
1888     if ( defined ( $filename ) )
1889     {
1890         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1891     }
1892
1893     return $self;
1894 }
1895
1896 =head2 setfile
1897
1898 This methods takes a filename, and attempts to open that file as the log file.
1899 If successful, all buffered data is written out to the file, and any further
1900 logging is written directly to the file.
1901
1902 =cut
1903 sub setfile
1904 {
1905     my $self = shift;
1906     my $filename = shift;
1907
1908     if ( defined ( $filename ) )
1909     {
1910         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1911     }
1912
1913     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1914
1915     while ( my $line = shift @{$self->{buffer}} )
1916     {
1917         print {$self->{fh}} $line;
1918     }
1919 }
1920
1921 =head2 nofile
1922
1923 This method indicates no logging is going to be used. It flushes any entries in
1924 the internal buffer, and sets a flag to ensure no further data is put there.
1925
1926 =cut
1927 sub nofile
1928 {
1929     my $self = shift;
1930
1931     $self->{nolog} = 1;
1932
1933     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1934
1935     $self->{buffer} = [];
1936 }
1937
1938 =head2 _logopen
1939
1940 Internal method. Returns true if the log file is open, false otherwise.
1941
1942 =cut
1943 sub _logopen
1944 {
1945     my $self = shift;
1946
1947     return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
1948     return 0;
1949 }
1950
1951 =head2 debug info warn fatal
1952
1953 These four methods are wrappers to _log. They provide the actual interface for
1954 logging data.
1955
1956 =cut
1957 sub debug { my $self = shift; $self->_log("debug", @_); }
1958 sub info  { my $self = shift; $self->_log("info" , @_); }
1959 sub warn  { my $self = shift; $self->_log("warn" , @_); }
1960 sub fatal { my $self = shift; $self->_log("fatal", @_); }
1961
1962 =head2 _log
1963
1964 This is an internal method called by the logging functions. It generates a
1965 timestamp and pushes the logged line either to file, or internal buffer.
1966
1967 =cut
1968 sub _log
1969 {
1970     my $self = shift;
1971     my $level = shift;
1972
1973     return if ( $self->{nolog} );
1974
1975     my @time = localtime;
1976     my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
1977         $time[5] + 1900,
1978         $time[4] + 1,
1979         $time[3],
1980         $time[2],
1981         $time[1],
1982         $time[0],
1983         uc $level,
1984     );
1985
1986     if ( $self->_logopen )
1987     {
1988         print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
1989     } else {
1990         push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
1991     }
1992 }
1993
1994 =head2 DESTROY
1995
1996 This method simply closes the file handle if one is open
1997
1998 =cut
1999 sub DESTROY
2000 {
2001     my $self = shift;
2002
2003     if ( $self->_logopen )
2004     {
2005         close $self->{fh};
2006     }
2007 }
2008
2009 package GITCVS::updater;
2010
2011 ####
2012 #### Copyright The Open University UK - 2006.
2013 ####
2014 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
2015 ####          Martin Langhoff <martin@catalyst.net.nz>
2016 ####
2017 ####
2018
2019 use strict;
2020 use warnings;
2021 use DBI;
2022
2023 =head1 METHODS
2024
2025 =cut
2026
2027 =head2 new
2028
2029 =cut
2030 sub new
2031 {
2032     my $class = shift;
2033     my $config = shift;
2034     my $module = shift;
2035     my $log = shift;
2036
2037     die "Need to specify a git repository" unless ( defined($config) and -d $config );
2038     die "Need to specify a module" unless ( defined($module) );
2039
2040     $class = ref($class) || $class;
2041
2042     my $self = {};
2043
2044     bless $self, $class;
2045
2046     $self->{dbdir} = $config . "/";
2047     die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
2048
2049     $self->{module} = $module;
2050     $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
2051
2052     $self->{git_path} = $config . "/";
2053
2054     $self->{log} = $log;
2055
2056     die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2057
2058     $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
2059
2060     $self->{tables} = {};
2061     foreach my $table ( $self->{dbh}->tables )
2062     {
2063         $table =~ s/^"//;
2064         $table =~ s/"$//;
2065         $self->{tables}{$table} = 1;
2066     }
2067
2068     # Construct the revision table if required
2069     unless ( $self->{tables}{revision} )
2070     {
2071         $self->{dbh}->do("
2072             CREATE TABLE revision (
2073                 name       TEXT NOT NULL,
2074                 revision   INTEGER NOT NULL,
2075                 filehash   TEXT NOT NULL,
2076                 commithash TEXT NOT NULL,
2077                 author     TEXT NOT NULL,
2078                 modified   TEXT NOT NULL,
2079                 mode       TEXT NOT NULL
2080             )
2081         ");
2082     }
2083
2084     # Construct the revision table if required
2085     unless ( $self->{tables}{head} )
2086     {
2087         $self->{dbh}->do("
2088             CREATE TABLE head (
2089                 name       TEXT NOT NULL,
2090                 revision   INTEGER NOT NULL,
2091                 filehash   TEXT NOT NULL,
2092                 commithash TEXT NOT NULL,
2093                 author     TEXT NOT NULL,
2094                 modified   TEXT NOT NULL,
2095                 mode       TEXT NOT NULL
2096             )
2097         ");
2098     }
2099
2100     # Construct the properties table if required
2101     unless ( $self->{tables}{properties} )
2102     {
2103         $self->{dbh}->do("
2104             CREATE TABLE properties (
2105                 key        TEXT NOT NULL PRIMARY KEY,
2106                 value      TEXT
2107             )
2108         ");
2109     }
2110
2111     # Construct the commitmsgs table if required
2112     unless ( $self->{tables}{commitmsgs} )
2113     {
2114         $self->{dbh}->do("
2115             CREATE TABLE commitmsgs (
2116                 key        TEXT NOT NULL PRIMARY KEY,
2117                 value      TEXT
2118             )
2119         ");
2120     }
2121
2122     return $self;
2123 }
2124
2125 =head2 update
2126
2127 =cut
2128 sub update
2129 {
2130     my $self = shift;
2131
2132     # first lets get the commit list
2133     $ENV{GIT_DIR} = $self->{git_path};
2134
2135     my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2136     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2137     {
2138         die("Invalid module '$self->{module}'");
2139     }
2140
2141
2142     my $git_log;
2143     my $lastcommit = $self->_get_prop("last_commit");
2144
2145     # Start exclusive lock here...
2146     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2147
2148     # TODO: log processing is memory bound
2149     # if we can parse into a 2nd file that is in reverse order
2150     # we can probably do something really efficient
2151     my @git_log_params = ('--pretty', '--parents', '--topo-order');
2152
2153     if (defined $lastcommit) {
2154         push @git_log_params, "$lastcommit..$self->{module}";
2155     } else {
2156         push @git_log_params, $self->{module};
2157     }
2158     # git-rev-list is the backend / plumbing version of git-log
2159     open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2160
2161     my @commits;
2162
2163     my %commit = ();
2164
2165     while ( <GITLOG> )
2166     {
2167         chomp;
2168         if (m/^commit\s+(.*)$/) {
2169             # on ^commit lines put the just seen commit in the stack
2170             # and prime things for the next one
2171             if (keys %commit) {
2172                 my %copy = %commit;
2173                 unshift @commits, \%copy;
2174                 %commit = ();
2175             }
2176             my @parents = split(m/\s+/, $1);
2177             $commit{hash} = shift @parents;
2178             $commit{parents} = \@parents;
2179         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2180             # on rfc822-like lines seen before we see any message,
2181             # lowercase the entry and put it in the hash as key-value
2182             $commit{lc($1)} = $2;
2183         } else {
2184             # message lines - skip initial empty line
2185             # and trim whitespace
2186             if (!exists($commit{message}) && m/^\s*$/) {
2187                 # define it to mark the end of headers
2188                 $commit{message} = '';
2189                 next;
2190             }
2191             s/^\s+//; s/\s+$//; # trim ws
2192             $commit{message} .= $_ . "\n";
2193         }
2194     }
2195     close GITLOG;
2196
2197     unshift @commits, \%commit if ( keys %commit );
2198
2199     # Now all the commits are in the @commits bucket
2200     # ordered by time DESC. for each commit that needs processing,
2201     # determine whether it's following the last head we've seen or if
2202     # it's on its own branch, grab a file list, and add whatever's changed
2203     # NOTE: $lastcommit refers to the last commit from previous run
2204     #       $lastpicked is the last commit we picked in this run
2205     my $lastpicked;
2206     my $head = {};
2207     if (defined $lastcommit) {
2208         $lastpicked = $lastcommit;
2209     }
2210
2211     my $committotal = scalar(@commits);
2212     my $commitcount = 0;
2213
2214     # Load the head table into $head (for cached lookups during the update process)
2215     foreach my $file ( @{$self->gethead()} )
2216     {
2217         $head->{$file->{name}} = $file;
2218     }
2219
2220     foreach my $commit ( @commits )
2221     {
2222         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2223         if (defined $lastpicked)
2224         {
2225             if (!in_array($lastpicked, @{$commit->{parents}}))
2226             {
2227                 # skip, we'll see this delta
2228                 # as part of a merge later
2229                 # warn "skipping off-track  $commit->{hash}\n";
2230                 next;
2231             } elsif (@{$commit->{parents}} > 1) {
2232                 # it is a merge commit, for each parent that is
2233                 # not $lastpicked, see if we can get a log
2234                 # from the merge-base to that parent to put it
2235                 # in the message as a merge summary.
2236                 my @parents = @{$commit->{parents}};
2237                 foreach my $parent (@parents) {
2238                     # git-merge-base can potentially (but rarely) throw
2239                     # several candidate merge bases. let's assume
2240                     # that the first one is the best one.
2241                     if ($parent eq $lastpicked) {
2242                         next;
2243                     }
2244                     open my $p, 'git-merge-base '. $lastpicked . ' '
2245                     . $parent . '|';
2246                     my @output = (<$p>);
2247                     close $p;
2248                     my $base = join('', @output);
2249                     chomp $base;
2250                     if ($base) {
2251                         my @merged;
2252                         # print "want to log between  $base $parent \n";
2253                         open(GITLOG, '-|', 'git-log', "$base..$parent")
2254                         or die "Cannot call git-log: $!";
2255                         my $mergedhash;
2256                         while (<GITLOG>) {
2257                             chomp;
2258                             if (!defined $mergedhash) {
2259                                 if (m/^commit\s+(.+)$/) {
2260                                     $mergedhash = $1;
2261                                 } else {
2262                                     next;
2263                                 }
2264                             } else {
2265                                 # grab the first line that looks non-rfc822
2266                                 # aka has content after leading space
2267                                 if (m/^\s+(\S.*)$/) {
2268                                     my $title = $1;
2269                                     $title = substr($title,0,100); # truncate
2270                                     unshift @merged, "$mergedhash $title";
2271                                     undef $mergedhash;
2272                                 }
2273                             }
2274                         }
2275                         close GITLOG;
2276                         if (@merged) {
2277                             $commit->{mergemsg} = $commit->{message};
2278                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2279                             foreach my $summary (@merged) {
2280                                 $commit->{mergemsg} .= "\t$summary\n";
2281                             }
2282                             $commit->{mergemsg} .= "\n\n";
2283                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2284                         }
2285                     }
2286                 }
2287             }
2288         }
2289
2290         # convert the date to CVS-happy format
2291         $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2292
2293         if ( defined ( $lastpicked ) )
2294         {
2295             my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2296             while ( <FILELIST> )
2297             {
2298                 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 )
2299                 {
2300                     die("Couldn't process git-diff-tree line : $_");
2301                 }
2302
2303                 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2304
2305                 my $git_perms = "";
2306                 $git_perms .= "r" if ( $1 & 4 );
2307                 $git_perms .= "w" if ( $1 & 2 );
2308                 $git_perms .= "x" if ( $1 & 1 );
2309                 $git_perms = "rw" if ( $git_perms eq "" );
2310
2311                 if ( $3 eq "D" )
2312                 {
2313                     #$log->debug("DELETE   $4");
2314                     $head->{$4} = {
2315                         name => $4,
2316                         revision => $head->{$4}{revision} + 1,
2317                         filehash => "deleted",
2318                         commithash => $commit->{hash},
2319                         modified => $commit->{date},
2320                         author => $commit->{author},
2321                         mode => $git_perms,
2322                     };
2323                     $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2324                 }
2325                 elsif ( $3 eq "M" )
2326                 {
2327                     #$log->debug("MODIFIED $4");
2328                     $head->{$4} = {
2329                         name => $4,
2330                         revision => $head->{$4}{revision} + 1,
2331                         filehash => $2,
2332                         commithash => $commit->{hash},
2333                         modified => $commit->{date},
2334                         author => $commit->{author},
2335                         mode => $git_perms,
2336                     };
2337                     $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2338                 }
2339                 elsif ( $3 eq "A" )
2340                 {
2341                     #$log->debug("ADDED    $4");
2342                     $head->{$4} = {
2343                         name => $4,
2344                         revision => 1,
2345                         filehash => $2,
2346                         commithash => $commit->{hash},
2347                         modified => $commit->{date},
2348                         author => $commit->{author},
2349                         mode => $git_perms,
2350                     };
2351                     $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2352                 }
2353                 else
2354                 {
2355                     $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2356                     die;
2357                 }
2358             }
2359             close FILELIST;
2360         } else {
2361             # this is used to detect files removed from the repo
2362             my $seen_files = {};
2363
2364             my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2365             while ( <FILELIST> )
2366             {
2367                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2368                 {
2369                     die("Couldn't process git-ls-tree line : $_");
2370                 }
2371
2372                 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2373
2374                 $seen_files->{$git_filename} = 1;
2375
2376                 my ( $oldhash, $oldrevision, $oldmode ) = (
2377                     $head->{$git_filename}{filehash},
2378                     $head->{$git_filename}{revision},
2379                     $head->{$git_filename}{mode}
2380                 );
2381
2382                 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2383                 {
2384                     $git_perms = "";
2385                     $git_perms .= "r" if ( $1 & 4 );
2386                     $git_perms .= "w" if ( $1 & 2 );
2387                     $git_perms .= "x" if ( $1 & 1 );
2388                 } else {
2389                     $git_perms = "rw";
2390                 }
2391
2392                 # unless the file exists with the same hash, we need to update it ...
2393                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2394                 {
2395                     my $newrevision = ( $oldrevision or 0 ) + 1;
2396
2397                     $head->{$git_filename} = {
2398                         name => $git_filename,
2399                         revision => $newrevision,
2400                         filehash => $git_hash,
2401                         commithash => $commit->{hash},
2402                         modified => $commit->{date},
2403                         author => $commit->{author},
2404                         mode => $git_perms,
2405                     };
2406
2407
2408                     $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2409                 }
2410             }
2411             close FILELIST;
2412
2413             # Detect deleted files
2414             foreach my $file ( keys %$head )
2415             {
2416                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2417                 {
2418                     $head->{$file}{revision}++;
2419                     $head->{$file}{filehash} = "deleted";
2420                     $head->{$file}{commithash} = $commit->{hash};
2421                     $head->{$file}{modified} = $commit->{date};
2422                     $head->{$file}{author} = $commit->{author};
2423
2424                     $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2425                 }
2426             }
2427             # END : "Detect deleted files"
2428         }
2429
2430
2431         if (exists $commit->{mergemsg})
2432         {
2433             $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
2434         }
2435
2436         $lastpicked = $commit->{hash};
2437
2438         $self->_set_prop("last_commit", $commit->{hash});
2439     }
2440
2441     $self->delete_head();
2442     foreach my $file ( keys %$head )
2443     {
2444         $self->insert_head(
2445             $file,
2446             $head->{$file}{revision},
2447             $head->{$file}{filehash},
2448             $head->{$file}{commithash},
2449             $head->{$file}{modified},
2450             $head->{$file}{author},
2451             $head->{$file}{mode},
2452         );
2453     }
2454     # invalidate the gethead cache
2455     $self->{gethead_cache} = undef;
2456
2457
2458     # Ending exclusive lock here
2459     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2460 }
2461
2462 sub insert_rev
2463 {
2464     my $self = shift;
2465     my $name = shift;
2466     my $revision = shift;
2467     my $filehash = shift;
2468     my $commithash = shift;
2469     my $modified = shift;
2470     my $author = shift;
2471     my $mode = shift;
2472
2473     my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2474     $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2475 }
2476
2477 sub insert_mergelog
2478 {
2479     my $self = shift;
2480     my $key = shift;
2481     my $value = shift;
2482
2483     my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2484     $insert_mergelog->execute($key, $value);
2485 }
2486
2487 sub delete_head
2488 {
2489     my $self = shift;
2490
2491     my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2492     $delete_head->execute();
2493 }
2494
2495 sub insert_head
2496 {
2497     my $self = shift;
2498     my $name = shift;
2499     my $revision = shift;
2500     my $filehash = shift;
2501     my $commithash = shift;
2502     my $modified = shift;
2503     my $author = shift;
2504     my $mode = shift;
2505
2506     my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2507     $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2508 }
2509
2510 sub _headrev
2511 {
2512     my $self = shift;
2513     my $filename = shift;
2514
2515     my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2516     $db_query->execute($filename);
2517     my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2518
2519     return ( $hash, $revision, $mode );
2520 }
2521
2522 sub _get_prop
2523 {
2524     my $self = shift;
2525     my $key = shift;
2526
2527     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2528     $db_query->execute($key);
2529     my ( $value ) = $db_query->fetchrow_array;
2530
2531     return $value;
2532 }
2533
2534 sub _set_prop
2535 {
2536     my $self = shift;
2537     my $key = shift;
2538     my $value = shift;
2539
2540     my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2541     $db_query->execute($value, $key);
2542
2543     unless ( $db_query->rows )
2544     {
2545         $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2546         $db_query->execute($key, $value);
2547     }
2548
2549     return $value;
2550 }
2551
2552 =head2 gethead
2553
2554 =cut
2555
2556 sub gethead
2557 {
2558     my $self = shift;
2559
2560     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2561
2562     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2563     $db_query->execute();
2564
2565     my $tree = [];
2566     while ( my $file = $db_query->fetchrow_hashref )
2567     {
2568         push @$tree, $file;
2569     }
2570
2571     $self->{gethead_cache} = $tree;
2572
2573     return $tree;
2574 }
2575
2576 =head2 getlog
2577
2578 =cut
2579
2580 sub getlog
2581 {
2582     my $self = shift;
2583     my $filename = shift;
2584
2585     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2586     $db_query->execute($filename);
2587
2588     my $tree = [];
2589     while ( my $file = $db_query->fetchrow_hashref )
2590     {
2591         push @$tree, $file;
2592     }
2593
2594     return $tree;
2595 }
2596
2597 =head2 getmeta
2598
2599 This function takes a filename (with path) argument and returns a hashref of
2600 metadata for that file.
2601
2602 =cut
2603
2604 sub getmeta
2605 {
2606     my $self = shift;
2607     my $filename = shift;
2608     my $revision = shift;
2609
2610     my $db_query;
2611     if ( defined($revision) and $revision =~ /^\d+$/ )
2612     {
2613         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2614         $db_query->execute($filename, $revision);
2615     }
2616     elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2617     {
2618         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2619         $db_query->execute($filename, $revision);
2620     } else {
2621         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2622         $db_query->execute($filename);
2623     }
2624
2625     return $db_query->fetchrow_hashref;
2626 }
2627
2628 =head2 commitmessage
2629
2630 this function takes a commithash and returns the commit message for that commit
2631
2632 =cut
2633 sub commitmessage
2634 {
2635     my $self = shift;
2636     my $commithash = shift;
2637
2638     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2639
2640     my $db_query;
2641     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2642     $db_query->execute($commithash);
2643
2644     my ( $message ) = $db_query->fetchrow_array;
2645
2646     if ( defined ( $message ) )
2647     {
2648         $message .= " " if ( $message =~ /\n$/ );
2649         return $message;
2650     }
2651
2652     my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2653     shift @lines while ( $lines[0] =~ /\S/ );
2654     $message = join("",@lines);
2655     $message .= " " if ( $message =~ /\n$/ );
2656     return $message;
2657 }
2658
2659 =head2 gethistory
2660
2661 This function takes a filename (with path) argument and returns an arrayofarrays
2662 containing revision,filehash,commithash ordered by revision descending
2663
2664 =cut
2665 sub gethistory
2666 {
2667     my $self = shift;
2668     my $filename = shift;
2669
2670     my $db_query;
2671     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2672     $db_query->execute($filename);
2673
2674     return $db_query->fetchall_arrayref;
2675 }
2676
2677 =head2 gethistorydense
2678
2679 This function takes a filename (with path) argument and returns an arrayofarrays
2680 containing revision,filehash,commithash ordered by revision descending.
2681
2682 This version of gethistory skips deleted entries -- so it is useful for annotate.
2683 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2684 and other git tools that depend on it.
2685
2686 =cut
2687 sub gethistorydense
2688 {
2689     my $self = shift;
2690     my $filename = shift;
2691
2692     my $db_query;
2693     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2694     $db_query->execute($filename);
2695
2696     return $db_query->fetchall_arrayref;
2697 }
2698
2699 =head2 in_array()
2700
2701 from Array::PAT - mimics the in_array() function
2702 found in PHP. Yuck but works for small arrays.
2703
2704 =cut
2705 sub in_array
2706 {
2707     my ($check, @array) = @_;
2708     my $retval = 0;
2709     foreach my $test (@array){
2710         if($check eq $test){
2711             $retval =  1;
2712         }
2713     }
2714     return $retval;
2715 }
2716
2717 =head2 safe_pipe_capture
2718
2719 an alternative to `command` that allows input to be passed as an array
2720 to work around shell problems with weird characters in arguments
2721
2722 =cut
2723 sub safe_pipe_capture {
2724
2725     my @output;
2726
2727     if (my $pid = open my $child, '-|') {
2728         @output = (<$child>);
2729         close $child or die join(' ',@_).": $! $?";
2730     } else {
2731         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2732     }
2733     return wantarray ? @output : join('',@output);
2734 }
2735
2736
2737 1;