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