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