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