git.oblomov.eu Git - git/blob - git-cvsserver.perl

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