git-cvsserver.perl

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