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 not exists ( $state->{opt}{C} ) )
 847         {
 848             $log->info("Tell the client the file is modified");
 849             print "MT text M \n";
 850             print "MT fname $filename\n";
 851             print "MT newline\n";
 852             next;
 853         }
 854
 855         if ( $meta->{filehash} eq "deleted" )
 856         {
 857             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 858
 859             $log->info("Removing '$filename' from working copy (no longer in the repo)");
 860
 861             print "E cvs update: `$filename' is no longer in the repository\n";
 862             # Don't want to actually _DO_ the update if -n specified
 863             unless ( $state->{globaloptions}{-n} ) {
 864                 print "Removed $dirpart\n";
 865                 print "$filepart\n";
 866             }
 867         }
 868         elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
 869                 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
 870                 or $meta->{filehash} eq 'added' )
 871         {
 872             # normal update, just send the new revision (either U=Update,
 873             # or A=Add, or R=Remove)
 874             if ( defined($wrev) && $wrev < 0 )
 875             {
 876                 $log->info("Tell the client the file is scheduled for removal");
 877                 print "MT text R \n";
 878                 print "MT fname $filename\n";
 879                 print "MT newline\n";
 880                 next;
 881             }
 882             elsif ( (!defined($wrev) || $wrev == 0) && (!defined($meta->{revision}) || $meta->{revision} == 0) )
 883             {
 884                 $log->info("Tell the client the file is scheduled for addition");
 885                 print "MT text A \n";
 886                 print "MT fname $filename\n";
 887                 print "MT newline\n";
 888                 next;
 889
 890             }
 891             else {
 892                 $log->info("Updating '$filename' to ".$meta->{revision});
 893                 print "MT +updated\n";
 894                 print "MT text U \n";
 895                 print "MT fname $filename\n";
 896                 print "MT newline\n";
 897                 print "MT -updated\n";
 898             }
 899
 900             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 901
 902             # Don't want to actually _DO_ the update if -n specified
 903             unless ( $state->{globaloptions}{-n} )
 904             {
 905                 if ( defined ( $wrev ) )
 906                 {
 907                     # instruct client we're sending a file to put in this path as a replacement
 908                     print "Update-existing $dirpart\n";
 909                     $log->debug("Updating existing file 'Update-existing $dirpart'");
 910                 } else {
 911                     # instruct client we're sending a file to put in this path as a new file
 912                     print "Clear-static-directory $dirpart\n";
 913                     print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
 914                     print "Clear-sticky $dirpart\n";
 915                     print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
 916
 917                     $log->debug("Creating new file 'Created $dirpart'");
 918                     print "Created $dirpart\n";
 919                 }
 920                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 921
 922                 # this is an "entries" line
 923                 my $kopts = kopts_from_path($filepart);
 924                 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
 925                 print "/$filepart/1.$meta->{revision}//$kopts/\n";
 926
 927                 # permissions
 928                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 929                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 930
 931                 # transmit file
 932                 transmitfile($meta->{filehash});
 933             }
 934         } else {
 935             $log->info("Updating '$filename'");
 936             my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
 937
 938             my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
 939
 940             chdir $dir;
 941             my $file_local = $filepart . ".mine";
 942             system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
 943             my $file_old = $filepart . "." . $oldmeta->{revision};
 944             transmitfile($oldmeta->{filehash}, $file_old);
 945             my $file_new = $filepart . "." . $meta->{revision};
 946             transmitfile($meta->{filehash}, $file_new);
 947
 948             # we need to merge with the local changes ( M=successful merge, C=conflict merge )
 949             $log->info("Merging $file_local, $file_old, $file_new");
 950             print "M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into $filename\n";
 951
 952             $log->debug("Temporary directory for merge is $dir");
 953
 954             my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
 955             $return >>= 8;
 956
 957             if ( $return == 0 )
 958             {
 959                 $log->info("Merged successfully");
 960                 print "M M $filename\n";
 961                 $log->debug("Merged $dirpart");
 962
 963                 # Don't want to actually _DO_ the update if -n specified
 964                 unless ( $state->{globaloptions}{-n} )
 965                 {
 966                     print "Merged $dirpart\n";
 967                     $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
 968                     print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 969                     my $kopts = kopts_from_path($filepart);
 970                     $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
 971                     print "/$filepart/1.$meta->{revision}//$kopts/\n";
 972                 }
 973             }
 974             elsif ( $return == 1 )
 975             {
 976                 $log->info("Merged with conflicts");
 977                 print "E cvs update: conflicts found in $filename\n";
 978                 print "M C $filename\n";
 979
 980                 # Don't want to actually _DO_ the update if -n specified
 981                 unless ( $state->{globaloptions}{-n} )
 982                 {
 983                     print "Merged $dirpart\n";
 984                     print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 985                     my $kopts = kopts_from_path($filepart);
 986                     print "/$filepart/1.$meta->{revision}/+/$kopts/\n";
 987                 }
 988             }
 989             else
 990             {
 991                 $log->warn("Merge failed");
 992                 next;
 993             }
 994
 995             # Don't want to actually _DO_ the update if -n specified
 996             unless ( $state->{globaloptions}{-n} )
 997             {
 998                 # permissions
 999                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1000                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1001
1002                 # transmit file, format is single integer on a line by itself (file
1003                 # size) followed by the file contents
1004                 # TODO : we should copy files in blocks
1005                 my $data = `cat $file_local`;
1006                 $log->debug("File size : " . length($data));
1007                 print length($data) . "\n";
1008                 print $data;
1009             }
1010
1011             chdir "/";
1012         }
1013
1014     }
1015
1016     print "ok\n";
1017 }
1018
1019 sub req_ci
1020 {
1021     my ( $cmd, $data ) = @_;
1022
1023     argsplit("ci");
1024
1025     #$log->debug("State : " . Dumper($state));
1026
1027     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1028
1029     if ( @ARGV && $ARGV[0] eq 'pserver')
1030     {
1031         print "error 1 pserver access cannot commit\n";
1032         exit;
1033     }
1034
1035     if ( -e $state->{CVSROOT} . "/index" )
1036     {
1037         $log->warn("file 'index' already exists in the git repository");
1038         print "error 1 Index already exists in git repo\n";
1039         exit;
1040     }
1041
1042     # Grab a handle to the SQLite db and do any necessary updates
1043     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1044     $updater->update();
1045
1046     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1047     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1048     $log->info("Lockless commit start, basing commit on '$tmpdir', index file is '$file_index'");
1049
1050     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1051     $ENV{GIT_INDEX_FILE} = $file_index;
1052
1053     # Remember where the head was at the beginning.
1054     my $parenthash = `git show-ref -s refs/heads/$state->{module}`;
1055     chomp $parenthash;
1056     if ($parenthash !~ /^[0-9a-f]{40}$/) {
1057             print "error 1 pserver cannot find the current HEAD of module";
1058             exit;
1059     }
1060
1061     chdir $tmpdir;
1062
1063     # populate the temporary index based
1064     system("git-read-tree", $parenthash);
1065     unless ($? == 0)
1066     {
1067         die "Error running git-read-tree $state->{module} $file_index $!";
1068     }
1069     $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
1070
1071     my @committedfiles = ();
1072
1073     # foreach file specified on the command line ...
1074     foreach my $filename ( @{$state->{args}} )
1075     {
1076         my $committedfile = $filename;
1077         $filename = filecleanup($filename);
1078
1079         next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1080
1081         my $meta = $updater->getmeta($filename);
1082
1083         my $wrev = revparse($filename);
1084
1085         my ( $filepart, $dirpart ) = filenamesplit($filename);
1086
1087         # do a checkout of the file if it part of this tree
1088         if ($wrev) {
1089             system('git-checkout-index', '-f', '-u', $filename);
1090             unless ($? == 0) {
1091                 die "Error running git-checkout-index -f -u $filename : $!";
1092             }
1093         }
1094
1095         my $addflag = 0;
1096         my $rmflag = 0;
1097         $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1098         $addflag = 1 unless ( -e $filename );
1099
1100         # Do up to date checking
1101         unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1102         {
1103             # fail everything if an up to date check fails
1104             print "error 1 Up to date check failed for $filename\n";
1105             chdir "/";
1106             exit;
1107         }
1108
1109         push @committedfiles, $committedfile;
1110         $log->info("Committing $filename");
1111
1112         system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1113
1114         unless ( $rmflag )
1115         {
1116             $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1117             rename $state->{entries}{$filename}{modified_filename},$filename;
1118
1119             # Calculate modes to remove
1120             my $invmode = "";
1121             foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1122
1123             $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1124             system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1125         }
1126
1127         if ( $rmflag )
1128         {
1129             $log->info("Removing file '$filename'");
1130             unlink($filename);
1131             system("git-update-index", "--remove", $filename);
1132         }
1133         elsif ( $addflag )
1134         {
1135             $log->info("Adding file '$filename'");
1136             system("git-update-index", "--add", $filename);
1137         } else {
1138             $log->info("Updating file '$filename'");
1139             system("git-update-index", $filename);
1140         }
1141     }
1142
1143     unless ( scalar(@committedfiles) > 0 )
1144     {
1145         print "E No files to commit\n";
1146         print "ok\n";
1147         chdir "/";
1148         return;
1149     }
1150
1151     my $treehash = `git-write-tree`;
1152     chomp $treehash;
1153
1154     $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1155
1156     # write our commit message out if we have one ...
1157     my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1158     print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1159     print $msg_fh "\n\nvia git-CVS emulator\n";
1160     close $msg_fh;
1161
1162     my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1163     chomp($commithash);
1164     $log->info("Commit hash : $commithash");
1165
1166     unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1167     {
1168         $log->warn("Commit failed (Invalid commit hash)");
1169         print "error 1 Commit failed (unknown reason)\n";
1170         chdir "/";
1171         exit;
1172     }
1173
1174         # Check that this is allowed, just as we would with a receive-pack
1175         my @cmd = ( $ENV{GIT_DIR}.'hooks/update', "refs/heads/$state->{module}",
1176                         $parenthash, $commithash );
1177         if( -x $cmd[0] ) {
1178                 unless( system( @cmd ) == 0 )
1179                 {
1180                         $log->warn("Commit failed (update hook declined to update ref)");
1181                         print "error 1 Commit failed (update hook declined)\n";
1182                         chdir "/";
1183                         exit;
1184                 }
1185         }
1186
1187         if (system(qw(git update-ref -m), "cvsserver ci",
1188                         "refs/heads/$state->{module}", $commithash, $parenthash)) {
1189                 $log->warn("update-ref for $state->{module} failed.");
1190                 print "error 1 Cannot commit -- update first\n";
1191                 exit;
1192         }
1193
1194     $updater->update();
1195
1196     # foreach file specified on the command line ...
1197     foreach my $filename ( @committedfiles )
1198     {
1199         $filename = filecleanup($filename);
1200
1201         my $meta = $updater->getmeta($filename);
1202         unless (defined $meta->{revision}) {
1203           $meta->{revision} = 1;
1204         }
1205
1206         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
1207
1208         $log->debug("Checked-in $dirpart : $filename");
1209
1210         if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
1211         {
1212             print "M new revision: delete\n";
1213             print "Remove-entry $dirpart\n";
1214             print "$filename\n";
1215         } else {
1216             if ($meta->{revision} == 1) {
1217                 print "M initial revision: 1.1\n";
1218             } else {
1219                 print "M new revision: 1.$meta->{revision}\n";
1220             }
1221             print "Checked-in $dirpart\n";
1222             print "$filename\n";
1223             my $kopts = kopts_from_path($filepart);
1224             print "/$filepart/1.$meta->{revision}//$kopts/\n";
1225         }
1226     }
1227
1228     chdir "/";
1229     print "ok\n";
1230 }
1231
1232 sub req_status
1233 {
1234     my ( $cmd, $data ) = @_;
1235
1236     argsplit("status");
1237
1238     $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1239     #$log->debug("status state : " . Dumper($state));
1240
1241     # Grab a handle to the SQLite db and do any necessary updates
1242     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1243     $updater->update();
1244
1245     # if no files were specified, we need to work out what files we should be providing status on ...
1246     argsfromdir($updater);
1247
1248     # foreach file specified on the command line ...
1249     foreach my $filename ( @{$state->{args}} )
1250     {
1251         $filename = filecleanup($filename);
1252
1253         my $meta = $updater->getmeta($filename);
1254         my $oldmeta = $meta;
1255
1256         my $wrev = revparse($filename);
1257
1258         # If the working copy is an old revision, lets get that version too for comparison.
1259         if ( defined($wrev) and $wrev != $meta->{revision} )
1260         {
1261             $oldmeta = $updater->getmeta($filename, $wrev);
1262         }
1263
1264         # TODO : All possible statuses aren't yet implemented
1265         my $status;
1266         # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1267         $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1268                                     and
1269                                     ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1270                                       or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1271                                    );
1272
1273         # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1274         $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1275                                           and
1276                                           ( $state->{entries}{$filename}{unchanged}
1277                                             or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1278                                         );
1279
1280         # Need checkout if it exists in the repo but doesn't have a working copy
1281         $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1282
1283         # Locally modified if working copy and repo copy have the same revision but there are local changes
1284         $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1285
1286         # Needs Merge if working copy revision is less than repo copy and there are local changes
1287         $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1288
1289         $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1290         $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1291         $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1292         $status ||= "File had conflicts on merge" if ( 0 );
1293
1294         $status ||= "Unknown";
1295
1296         print "M ===================================================================\n";
1297         print "M File: $filename\tStatus: $status\n";
1298         if ( defined($state->{entries}{$filename}{revision}) )
1299         {
1300             print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1301         } else {
1302             print "M Working revision:\tNo entry for $filename\n";
1303         }
1304         if ( defined($meta->{revision}) )
1305         {
1306             print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1307             print "M Sticky Tag:\t\t(none)\n";
1308             print "M Sticky Date:\t\t(none)\n";
1309             print "M Sticky Options:\t\t(none)\n";
1310         } else {
1311             print "M Repository revision:\tNo revision control file\n";
1312         }
1313         print "M\n";
1314     }
1315
1316     print "ok\n";
1317 }
1318
1319 sub req_diff
1320 {
1321     my ( $cmd, $data ) = @_;
1322
1323     argsplit("diff");
1324
1325     $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1326     #$log->debug("status state : " . Dumper($state));
1327
1328     my ($revision1, $revision2);
1329     if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1330     {
1331         $revision1 = $state->{opt}{r}[0];
1332         $revision2 = $state->{opt}{r}[1];
1333     } else {
1334         $revision1 = $state->{opt}{r};
1335     }
1336
1337     $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1338     $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1339
1340     $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1341
1342     # Grab a handle to the SQLite db and do any necessary updates
1343     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1344     $updater->update();
1345
1346     # if no files were specified, we need to work out what files we should be providing status on ...
1347     argsfromdir($updater);
1348
1349     # foreach file specified on the command line ...
1350     foreach my $filename ( @{$state->{args}} )
1351     {
1352         $filename = filecleanup($filename);
1353
1354         my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1355
1356         my $wrev = revparse($filename);
1357
1358         # We need _something_ to diff against
1359         next unless ( defined ( $wrev ) );
1360
1361         # if we have a -r switch, use it
1362         if ( defined ( $revision1 ) )
1363         {
1364             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1365             $meta1 = $updater->getmeta($filename, $revision1);
1366             unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1367             {
1368                 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1369                 next;
1370             }
1371             transmitfile($meta1->{filehash}, $file1);
1372         }
1373         # otherwise we just use the working copy revision
1374         else
1375         {
1376             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1377             $meta1 = $updater->getmeta($filename, $wrev);
1378             transmitfile($meta1->{filehash}, $file1);
1379         }
1380
1381         # if we have a second -r switch, use it too
1382         if ( defined ( $revision2 ) )
1383         {
1384             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1385             $meta2 = $updater->getmeta($filename, $revision2);
1386
1387             unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1388             {
1389                 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1390                 next;
1391             }
1392
1393             transmitfile($meta2->{filehash}, $file2);
1394         }
1395         # otherwise we just use the working copy
1396         else
1397         {
1398             $file2 = $state->{entries}{$filename}{modified_filename};
1399         }
1400
1401         # if we have been given -r, and we don't have a $file2 yet, lets get one
1402         if ( defined ( $revision1 ) and not defined ( $file2 ) )
1403         {
1404             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1405             $meta2 = $updater->getmeta($filename, $wrev);
1406             transmitfile($meta2->{filehash}, $file2);
1407         }
1408
1409         # We need to have retrieved something useful
1410         next unless ( defined ( $meta1 ) );
1411
1412         # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1413         next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1414                   and
1415                    ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1416                      or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1417                   );
1418
1419         # Apparently we only show diffs for locally modified files
1420         next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1421
1422         print "M Index: $filename\n";
1423         print "M ===================================================================\n";
1424         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1425         print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1426         print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1427         print "M diff ";
1428         foreach my $opt ( keys %{$state->{opt}} )
1429         {
1430             if ( ref $state->{opt}{$opt} eq "ARRAY" )
1431             {
1432                 foreach my $value ( @{$state->{opt}{$opt}} )
1433                 {
1434                     print "-$opt $value ";
1435                 }
1436             } else {
1437                 print "-$opt ";
1438                 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1439             }
1440         }
1441         print "$filename\n";
1442
1443         $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1444
1445         ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1446
1447         if ( exists $state->{opt}{u} )
1448         {
1449             system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1450         } else {
1451             system("diff $file1 $file2 > $filediff");
1452         }
1453
1454         while ( <$fh> )
1455         {
1456             print "M $_";
1457         }
1458         close $fh;
1459     }
1460
1461     print "ok\n";
1462 }
1463
1464 sub req_log
1465 {
1466     my ( $cmd, $data ) = @_;
1467
1468     argsplit("log");
1469
1470     $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1471     #$log->debug("log state : " . Dumper($state));
1472
1473     my ( $minrev, $maxrev );
1474     if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1475     {
1476         my $control = $2;
1477         $minrev = $1;
1478         $maxrev = $3;
1479         $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1480         $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1481         $minrev++ if ( defined($minrev) and $control eq "::" );
1482     }
1483
1484     # Grab a handle to the SQLite db and do any necessary updates
1485     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1486     $updater->update();
1487
1488     # if no files were specified, we need to work out what files we should be providing status on ...
1489     argsfromdir($updater);
1490
1491     # foreach file specified on the command line ...
1492     foreach my $filename ( @{$state->{args}} )
1493     {
1494         $filename = filecleanup($filename);
1495
1496         my $headmeta = $updater->getmeta($filename);
1497
1498         my $revisions = $updater->getlog($filename);
1499         my $totalrevisions = scalar(@$revisions);
1500
1501         if ( defined ( $minrev ) )
1502         {
1503             $log->debug("Removing revisions less than $minrev");
1504             while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1505             {
1506                 pop @$revisions;
1507             }
1508         }
1509         if ( defined ( $maxrev ) )
1510         {
1511             $log->debug("Removing revisions greater than $maxrev");
1512             while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1513             {
1514                 shift @$revisions;
1515             }
1516         }
1517
1518         next unless ( scalar(@$revisions) );
1519
1520         print "M \n";
1521         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1522         print "M Working file: $filename\n";
1523         print "M head: 1.$headmeta->{revision}\n";
1524         print "M branch:\n";
1525         print "M locks: strict\n";
1526         print "M access list:\n";
1527         print "M symbolic names:\n";
1528         print "M keyword substitution: kv\n";
1529         print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1530         print "M description:\n";
1531
1532         foreach my $revision ( @$revisions )
1533         {
1534             print "M ----------------------------\n";
1535             print "M revision 1.$revision->{revision}\n";
1536             # reformat the date for log output
1537             $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}) );
1538             $revision->{author} =~ s/\s+.*//;
1539             $revision->{author} =~ s/^(.{8}).*/$1/;
1540             print "M date: $revision->{modified};  author: $revision->{author};  state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . ";  lines: +2 -3\n";
1541             my $commitmessage = $updater->commitmessage($revision->{commithash});
1542             $commitmessage =~ s/^/M /mg;
1543             print $commitmessage . "\n";
1544         }
1545         print "M =============================================================================\n";
1546     }
1547
1548     print "ok\n";
1549 }
1550
1551 sub req_annotate
1552 {
1553     my ( $cmd, $data ) = @_;
1554
1555     argsplit("annotate");
1556
1557     $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1558     #$log->debug("status state : " . Dumper($state));
1559
1560     # Grab a handle to the SQLite db and do any necessary updates
1561     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1562     $updater->update();
1563
1564     # if no files were specified, we need to work out what files we should be providing annotate on ...
1565     argsfromdir($updater);
1566
1567     # we'll need a temporary checkout dir
1568     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1569     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1570     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1571
1572     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1573     $ENV{GIT_INDEX_FILE} = $file_index;
1574
1575     chdir $tmpdir;
1576
1577     # foreach file specified on the command line ...
1578     foreach my $filename ( @{$state->{args}} )
1579     {
1580         $filename = filecleanup($filename);
1581
1582         my $meta = $updater->getmeta($filename);
1583
1584         next unless ( $meta->{revision} );
1585
1586         # get all the commits that this file was in
1587         # in dense format -- aka skip dead revisions
1588         my $revisions   = $updater->gethistorydense($filename);
1589         my $lastseenin  = $revisions->[0][2];
1590
1591         # populate the temporary index based on the latest commit were we saw
1592         # the file -- but do it cheaply without checking out any files
1593         # TODO: if we got a revision from the client, use that instead
1594         # to look up the commithash in sqlite (still good to default to
1595         # the current head as we do now)
1596         system("git-read-tree", $lastseenin);
1597         unless ($? == 0)
1598         {
1599             die "Error running git-read-tree $lastseenin $file_index $!";
1600         }
1601         $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1602
1603         # do a checkout of the file
1604         system('git-checkout-index', '-f', '-u', $filename);
1605         unless ($? == 0) {
1606             die "Error running git-checkout-index -f -u $filename : $!";
1607         }
1608
1609         $log->info("Annotate $filename");
1610
1611         # Prepare a file with the commits from the linearized
1612         # history that annotate should know about. This prevents
1613         # git-jsannotate telling us about commits we are hiding
1614         # from the client.
1615
1616         open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1617         for (my $i=0; $i < @$revisions; $i++)
1618         {
1619             print ANNOTATEHINTS $revisions->[$i][2];
1620             if ($i+1 < @$revisions) { # have we got a parent?
1621                 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1622             }
1623             print ANNOTATEHINTS "\n";
1624         }
1625
1626         print ANNOTATEHINTS "\n";
1627         close ANNOTATEHINTS;
1628
1629         my $annotatecmd = 'git-annotate';
1630         open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1631             or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1632         my $metadata = {};
1633         print "E Annotations for $filename\n";
1634         print "E ***************\n";
1635         while ( <ANNOTATE> )
1636         {
1637             if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1638             {
1639                 my $commithash = $1;
1640                 my $data = $2;
1641                 unless ( defined ( $metadata->{$commithash} ) )
1642                 {
1643                     $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1644                     $metadata->{$commithash}{author} =~ s/\s+.*//;
1645                     $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1646                     $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1647                 }
1648                 printf("M 1.%-5d      (%-8s %10s): %s\n",
1649                     $metadata->{$commithash}{revision},
1650                     $metadata->{$commithash}{author},
1651                     $metadata->{$commithash}{modified},
1652                     $data
1653                 );
1654             } else {
1655                 $log->warn("Error in annotate output! LINE: $_");
1656                 print "E Annotate error \n";
1657                 next;
1658             }
1659         }
1660         close ANNOTATE;
1661     }
1662
1663     # done; get out of the tempdir
1664     chdir "/";
1665
1666     print "ok\n";
1667
1668 }
1669
1670 # This method takes the state->{arguments} array and produces two new arrays.
1671 # The first is $state->{args} which is everything before the '--' argument, and
1672 # the second is $state->{files} which is everything after it.
1673 sub argsplit
1674 {
1675     return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1676
1677     my $type = shift;
1678
1679     $state->{args} = [];
1680     $state->{files} = [];
1681     $state->{opt} = {};
1682
1683     if ( defined($type) )
1684     {
1685         my $opt = {};
1686         $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" );
1687         $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1688         $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" );
1689         $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1690         $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1691         $opt = { k => 1, m => 1 } if ( $type eq "add" );
1692         $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1693         $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" );
1694
1695
1696         while ( scalar ( @{$state->{arguments}} ) > 0 )
1697         {
1698             my $arg = shift @{$state->{arguments}};
1699
1700             next if ( $arg eq "--" );
1701             next unless ( $arg =~ /\S/ );
1702
1703             # if the argument looks like a switch
1704             if ( $arg =~ /^-(\w)(.*)/ )
1705             {
1706                 # if it's a switch that takes an argument
1707                 if ( $opt->{$1} )
1708                 {
1709                     # If this switch has already been provided
1710                     if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1711                     {
1712                         $state->{opt}{$1} = [ $state->{opt}{$1} ];
1713                         if ( length($2) > 0 )
1714                         {
1715                             push @{$state->{opt}{$1}},$2;
1716                         } else {
1717                             push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1718                         }
1719                     } else {
1720                         # if there's extra data in the arg, use that as the argument for the switch
1721                         if ( length($2) > 0 )
1722                         {
1723                             $state->{opt}{$1} = $2;
1724                         } else {
1725                             $state->{opt}{$1} = shift @{$state->{arguments}};
1726                         }
1727                     }
1728                 } else {
1729                     $state->{opt}{$1} = undef;
1730                 }
1731             }
1732             else
1733             {
1734                 push @{$state->{args}}, $arg;
1735             }
1736         }
1737     }
1738     else
1739     {
1740         my $mode = 0;
1741
1742         foreach my $value ( @{$state->{arguments}} )
1743         {
1744             if ( $value eq "--" )
1745             {
1746                 $mode++;
1747                 next;
1748             }
1749             push @{$state->{args}}, $value if ( $mode == 0 );
1750             push @{$state->{files}}, $value if ( $mode == 1 );
1751         }
1752     }
1753 }
1754
1755 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1756 sub argsfromdir
1757 {
1758     my $updater = shift;
1759
1760     $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
1761
1762     return if ( scalar ( @{$state->{args}} ) > 1 );
1763
1764     my @gethead = @{$updater->gethead};
1765
1766     # push added files
1767     foreach my $file (keys %{$state->{entries}}) {
1768         if ( exists $state->{entries}{$file}{revision} &&
1769                 $state->{entries}{$file}{revision} == 0 )
1770         {
1771             push @gethead, { name => $file, filehash => 'added' };
1772         }
1773     }
1774
1775     if ( scalar(@{$state->{args}}) == 1 )
1776     {
1777         my $arg = $state->{args}[0];
1778         $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
1779
1780         $log->info("Only one arg specified, checking for directory expansion on '$arg'");
1781
1782         foreach my $file ( @gethead )
1783         {
1784             next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1785             next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg  );
1786             push @{$state->{args}}, $file->{name};
1787         }
1788
1789         shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
1790     } else {
1791         $log->info("Only one arg specified, populating file list automatically");
1792
1793         $state->{args} = [];
1794
1795         foreach my $file ( @gethead )
1796         {
1797             next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1798             next unless ( $file->{name} =~ s/^$state->{prependdir}// );
1799             push @{$state->{args}}, $file->{name};
1800         }
1801     }
1802 }
1803
1804 # This method cleans up the $state variable after a command that uses arguments has run
1805 sub statecleanup
1806 {
1807     $state->{files} = [];
1808     $state->{args} = [];
1809     $state->{arguments} = [];
1810     $state->{entries} = {};
1811 }
1812
1813 sub revparse
1814 {
1815     my $filename = shift;
1816
1817     return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1818
1819     return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1820     return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1821
1822     return undef;
1823 }
1824
1825 # This method takes a file hash and does a CVS "file transfer" which transmits the
1826 # size of the file, and then the file contents.
1827 # If a second argument $targetfile is given, the file is instead written out to
1828 # a file by the name of $targetfile
1829 sub transmitfile
1830 {
1831     my $filehash = shift;
1832     my $targetfile = shift;
1833
1834     if ( defined ( $filehash ) and $filehash eq "deleted" )
1835     {
1836         $log->warn("filehash is 'deleted'");
1837         return;
1838     }
1839
1840     die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1841
1842     my $type = `git-cat-file -t $filehash`;
1843     chomp $type;
1844
1845     die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1846
1847     my $size = `git-cat-file -s $filehash`;
1848     chomp $size;
1849
1850     $log->debug("transmitfile($filehash) size=$size, type=$type");
1851
1852     if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1853     {
1854         if ( defined ( $targetfile ) )
1855         {
1856             open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1857             print NEWFILE $_ while ( <$fh> );
1858             close NEWFILE;
1859         } else {
1860             print "$size\n";
1861             print while ( <$fh> );
1862         }
1863         close $fh or die ("Couldn't close filehandle for transmitfile()");
1864     } else {
1865         die("Couldn't execute git-cat-file");
1866     }
1867 }
1868
1869 # This method takes a file name, and returns ( $dirpart, $filepart ) which
1870 # refers to the directory portion and the file portion of the filename
1871 # respectively
1872 sub filenamesplit
1873 {
1874     my $filename = shift;
1875     my $fixforlocaldir = shift;
1876
1877     my ( $filepart, $dirpart ) = ( $filename, "." );
1878     ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1879     $dirpart .= "/";
1880
1881     if ( $fixforlocaldir )
1882     {
1883         $dirpart =~ s/^$state->{prependdir}//;
1884     }
1885
1886     return ( $filepart, $dirpart );
1887 }
1888
1889 sub filecleanup
1890 {
1891     my $filename = shift;
1892
1893     return undef unless(defined($filename));
1894     if ( $filename =~ /^\// )
1895     {
1896         print "E absolute filenames '$filename' not supported by server\n";
1897         return undef;
1898     }
1899
1900     $filename =~ s/^\.\///g;
1901     $filename = $state->{prependdir} . $filename;
1902     return $filename;
1903 }
1904
1905 # Given a path, this function returns a string containing the kopts
1906 # that should go into that path's Entries line.  For example, a binary
1907 # file should get -kb.
1908 sub kopts_from_path
1909 {
1910         my ($path) = @_;
1911
1912         # Once it exists, the git attributes system should be used to look up
1913         # what attributes apply to this path.
1914
1915         # Until then, take the setting from the config file
1916     unless ( defined ( $cfg->{gitcvs}{allbinary} ) and $cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i )
1917     {
1918                 # Return "" to give no special treatment to any path
1919                 return "";
1920     } else {
1921                 # Alternatively, to have all files treated as if they are binary (which
1922                 # is more like git itself), always return the "-kb" option
1923                 return "-kb";
1924     }
1925 }
1926
1927 package GITCVS::log;
1928
1929 ####
1930 #### Copyright The Open University UK - 2006.
1931 ####
1932 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1933 ####          Martin Langhoff <martin@catalyst.net.nz>
1934 ####
1935 ####
1936
1937 use strict;
1938 use warnings;
1939
1940 =head1 NAME
1941
1942 GITCVS::log
1943
1944 =head1 DESCRIPTION
1945
1946 This module provides very crude logging with a similar interface to
1947 Log::Log4perl
1948
1949 =head1 METHODS
1950
1951 =cut
1952
1953 =head2 new
1954
1955 Creates a new log object, optionally you can specify a filename here to
1956 indicate the file to log to. If no log file is specified, you can specify one
1957 later with method setfile, or indicate you no longer want logging with method
1958 nofile.
1959
1960 Until one of these methods is called, all log calls will buffer messages ready
1961 to write out.
1962
1963 =cut
1964 sub new
1965 {
1966     my $class = shift;
1967     my $filename = shift;
1968
1969     my $self = {};
1970
1971     bless $self, $class;
1972
1973     if ( defined ( $filename ) )
1974     {
1975         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1976     }
1977
1978     return $self;
1979 }
1980
1981 =head2 setfile
1982
1983 This methods takes a filename, and attempts to open that file as the log file.
1984 If successful, all buffered data is written out to the file, and any further
1985 logging is written directly to the file.
1986
1987 =cut
1988 sub setfile
1989 {
1990     my $self = shift;
1991     my $filename = shift;
1992
1993     if ( defined ( $filename ) )
1994     {
1995         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1996     }
1997
1998     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1999
2000     while ( my $line = shift @{$self->{buffer}} )
2001     {
2002         print {$self->{fh}} $line;
2003     }
2004 }
2005
2006 =head2 nofile
2007
2008 This method indicates no logging is going to be used. It flushes any entries in
2009 the internal buffer, and sets a flag to ensure no further data is put there.
2010
2011 =cut
2012 sub nofile
2013 {
2014     my $self = shift;
2015
2016     $self->{nolog} = 1;
2017
2018     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2019
2020     $self->{buffer} = [];
2021 }
2022
2023 =head2 _logopen
2024
2025 Internal method. Returns true if the log file is open, false otherwise.
2026
2027 =cut
2028 sub _logopen
2029 {
2030     my $self = shift;
2031
2032     return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
2033     return 0;
2034 }
2035
2036 =head2 debug info warn fatal
2037
2038 These four methods are wrappers to _log. They provide the actual interface for
2039 logging data.
2040
2041 =cut
2042 sub debug { my $self = shift; $self->_log("debug", @_); }
2043 sub info  { my $self = shift; $self->_log("info" , @_); }
2044 sub warn  { my $self = shift; $self->_log("warn" , @_); }
2045 sub fatal { my $self = shift; $self->_log("fatal", @_); }
2046
2047 =head2 _log
2048
2049 This is an internal method called by the logging functions. It generates a
2050 timestamp and pushes the logged line either to file, or internal buffer.
2051
2052 =cut
2053 sub _log
2054 {
2055     my $self = shift;
2056     my $level = shift;
2057
2058     return if ( $self->{nolog} );
2059
2060     my @time = localtime;
2061     my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2062         $time[5] + 1900,
2063         $time[4] + 1,
2064         $time[3],
2065         $time[2],
2066         $time[1],
2067         $time[0],
2068         uc $level,
2069     );
2070
2071     if ( $self->_logopen )
2072     {
2073         print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
2074     } else {
2075         push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
2076     }
2077 }
2078
2079 =head2 DESTROY
2080
2081 This method simply closes the file handle if one is open
2082
2083 =cut
2084 sub DESTROY
2085 {
2086     my $self = shift;
2087
2088     if ( $self->_logopen )
2089     {
2090         close $self->{fh};
2091     }
2092 }
2093
2094 package GITCVS::updater;
2095
2096 ####
2097 #### Copyright The Open University UK - 2006.
2098 ####
2099 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
2100 ####          Martin Langhoff <martin@catalyst.net.nz>
2101 ####
2102 ####
2103
2104 use strict;
2105 use warnings;
2106 use DBI;
2107
2108 =head1 METHODS
2109
2110 =cut
2111
2112 =head2 new
2113
2114 =cut
2115 sub new
2116 {
2117     my $class = shift;
2118     my $config = shift;
2119     my $module = shift;
2120     my $log = shift;
2121
2122     die "Need to specify a git repository" unless ( defined($config) and -d $config );
2123     die "Need to specify a module" unless ( defined($module) );
2124
2125     $class = ref($class) || $class;
2126
2127     my $self = {};
2128
2129     bless $self, $class;
2130
2131     $self->{dbdir} = $config . "/";
2132     die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
2133
2134     $self->{module} = $module;
2135     $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
2136
2137     $self->{git_path} = $config . "/";
2138
2139     $self->{log} = $log;
2140
2141     die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2142
2143     $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
2144
2145     $self->{tables} = {};
2146     foreach my $table ( $self->{dbh}->tables )
2147     {
2148         $table =~ s/^"//;
2149         $table =~ s/"$//;
2150         $self->{tables}{$table} = 1;
2151     }
2152
2153     # Construct the revision table if required
2154     unless ( $self->{tables}{revision} )
2155     {
2156         $self->{dbh}->do("
2157             CREATE TABLE revision (
2158                 name       TEXT NOT NULL,
2159                 revision   INTEGER NOT NULL,
2160                 filehash   TEXT NOT NULL,
2161                 commithash TEXT NOT NULL,
2162                 author     TEXT NOT NULL,
2163                 modified   TEXT NOT NULL,
2164                 mode       TEXT NOT NULL
2165             )
2166         ");
2167         $self->{dbh}->do("
2168             CREATE INDEX revision_ix1
2169             ON revision (name,revision)
2170         ");
2171         $self->{dbh}->do("
2172             CREATE INDEX revision_ix2
2173             ON revision (name,commithash)
2174         ");
2175     }
2176
2177     # Construct the head table if required
2178     unless ( $self->{tables}{head} )
2179     {
2180         $self->{dbh}->do("
2181             CREATE TABLE head (
2182                 name       TEXT NOT NULL,
2183                 revision   INTEGER NOT NULL,
2184                 filehash   TEXT NOT NULL,
2185                 commithash TEXT NOT NULL,
2186                 author     TEXT NOT NULL,
2187                 modified   TEXT NOT NULL,
2188                 mode       TEXT NOT NULL
2189             )
2190         ");
2191         $self->{dbh}->do("
2192             CREATE INDEX head_ix1
2193             ON head (name)
2194         ");
2195     }
2196
2197     # Construct the properties table if required
2198     unless ( $self->{tables}{properties} )
2199     {
2200         $self->{dbh}->do("
2201             CREATE TABLE properties (
2202                 key        TEXT NOT NULL PRIMARY KEY,
2203                 value      TEXT
2204             )
2205         ");
2206     }
2207
2208     # Construct the commitmsgs table if required
2209     unless ( $self->{tables}{commitmsgs} )
2210     {
2211         $self->{dbh}->do("
2212             CREATE TABLE commitmsgs (
2213                 key        TEXT NOT NULL PRIMARY KEY,
2214                 value      TEXT
2215             )
2216         ");
2217     }
2218
2219     return $self;
2220 }
2221
2222 =head2 update
2223
2224 =cut
2225 sub update
2226 {
2227     my $self = shift;
2228
2229     # first lets get the commit list
2230     $ENV{GIT_DIR} = $self->{git_path};
2231
2232     my $commitsha1 = `git rev-parse $self->{module}`;
2233     chomp $commitsha1;
2234
2235     my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
2236     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2237     {
2238         die("Invalid module '$self->{module}'");
2239     }
2240
2241
2242     my $git_log;
2243     my $lastcommit = $self->_get_prop("last_commit");
2244
2245     if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
2246          return 1;
2247     }
2248
2249     # Start exclusive lock here...
2250     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2251
2252     # TODO: log processing is memory bound
2253     # if we can parse into a 2nd file that is in reverse order
2254     # we can probably do something really efficient
2255     my @git_log_params = ('--pretty', '--parents', '--topo-order');
2256
2257     if (defined $lastcommit) {
2258         push @git_log_params, "$lastcommit..$self->{module}";
2259     } else {
2260         push @git_log_params, $self->{module};
2261     }
2262     # git-rev-list is the backend / plumbing version of git-log
2263     open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2264
2265     my @commits;
2266
2267     my %commit = ();
2268
2269     while ( <GITLOG> )
2270     {
2271         chomp;
2272         if (m/^commit\s+(.*)$/) {
2273             # on ^commit lines put the just seen commit in the stack
2274             # and prime things for the next one
2275             if (keys %commit) {
2276                 my %copy = %commit;
2277                 unshift @commits, \%copy;
2278                 %commit = ();
2279             }
2280             my @parents = split(m/\s+/, $1);
2281             $commit{hash} = shift @parents;
2282             $commit{parents} = \@parents;
2283         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2284             # on rfc822-like lines seen before we see any message,
2285             # lowercase the entry and put it in the hash as key-value
2286             $commit{lc($1)} = $2;
2287         } else {
2288             # message lines - skip initial empty line
2289             # and trim whitespace
2290             if (!exists($commit{message}) && m/^\s*$/) {
2291                 # define it to mark the end of headers
2292                 $commit{message} = '';
2293                 next;
2294             }
2295             s/^\s+//; s/\s+$//; # trim ws
2296             $commit{message} .= $_ . "\n";
2297         }
2298     }
2299     close GITLOG;
2300
2301     unshift @commits, \%commit if ( keys %commit );
2302
2303     # Now all the commits are in the @commits bucket
2304     # ordered by time DESC. for each commit that needs processing,
2305     # determine whether it's following the last head we've seen or if
2306     # it's on its own branch, grab a file list, and add whatever's changed
2307     # NOTE: $lastcommit refers to the last commit from previous run
2308     #       $lastpicked is the last commit we picked in this run
2309     my $lastpicked;
2310     my $head = {};
2311     if (defined $lastcommit) {
2312         $lastpicked = $lastcommit;
2313     }
2314
2315     my $committotal = scalar(@commits);
2316     my $commitcount = 0;
2317
2318     # Load the head table into $head (for cached lookups during the update process)
2319     foreach my $file ( @{$self->gethead()} )
2320     {
2321         $head->{$file->{name}} = $file;
2322     }
2323
2324     foreach my $commit ( @commits )
2325     {
2326         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2327         if (defined $lastpicked)
2328         {
2329             if (!in_array($lastpicked, @{$commit->{parents}}))
2330             {
2331                 # skip, we'll see this delta
2332                 # as part of a merge later
2333                 # warn "skipping off-track  $commit->{hash}\n";
2334                 next;
2335             } elsif (@{$commit->{parents}} > 1) {
2336                 # it is a merge commit, for each parent that is
2337                 # not $lastpicked, see if we can get a log
2338                 # from the merge-base to that parent to put it
2339                 # in the message as a merge summary.
2340                 my @parents = @{$commit->{parents}};
2341                 foreach my $parent (@parents) {
2342                     # git-merge-base can potentially (but rarely) throw
2343                     # several candidate merge bases. let's assume
2344                     # that the first one is the best one.
2345                     if ($parent eq $lastpicked) {
2346                         next;
2347                     }
2348                     open my $p, 'git-merge-base '. $lastpicked . ' '
2349                     . $parent . '|';
2350                     my @output = (<$p>);
2351                     close $p;
2352                     my $base = join('', @output);
2353                     chomp $base;
2354                     if ($base) {
2355                         my @merged;
2356                         # print "want to log between  $base $parent \n";
2357                         open(GITLOG, '-|', 'git-log', "$base..$parent")
2358                         or die "Cannot call git-log: $!";
2359                         my $mergedhash;
2360                         while (<GITLOG>) {
2361                             chomp;
2362                             if (!defined $mergedhash) {
2363                                 if (m/^commit\s+(.+)$/) {
2364                                     $mergedhash = $1;
2365                                 } else {
2366                                     next;
2367                                 }
2368                             } else {
2369                                 # grab the first line that looks non-rfc822
2370                                 # aka has content after leading space
2371                                 if (m/^\s+(\S.*)$/) {
2372                                     my $title = $1;
2373                                     $title = substr($title,0,100); # truncate
2374                                     unshift @merged, "$mergedhash $title";
2375                                     undef $mergedhash;
2376                                 }
2377                             }
2378                         }
2379                         close GITLOG;
2380                         if (@merged) {
2381                             $commit->{mergemsg} = $commit->{message};
2382                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2383                             foreach my $summary (@merged) {
2384                                 $commit->{mergemsg} .= "\t$summary\n";
2385                             }
2386                             $commit->{mergemsg} .= "\n\n";
2387                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2388                         }
2389                     }
2390                 }
2391             }
2392         }
2393
2394         # convert the date to CVS-happy format
2395         $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2396
2397         if ( defined ( $lastpicked ) )
2398         {
2399             my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2400             local ($/) = "\0";
2401             while ( <FILELIST> )
2402             {
2403                 chomp;
2404                 unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
2405                 {
2406                     die("Couldn't process git-diff-tree line : $_");
2407                 }
2408                 my ($mode, $hash, $change) = ($1, $2, $3);
2409                 my $name = <FILELIST>;
2410                 chomp($name);
2411
2412                 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
2413
2414                 my $git_perms = "";
2415                 $git_perms .= "r" if ( $mode & 4 );
2416                 $git_perms .= "w" if ( $mode & 2 );
2417                 $git_perms .= "x" if ( $mode & 1 );
2418                 $git_perms = "rw" if ( $git_perms eq "" );
2419
2420                 if ( $change eq "D" )
2421                 {
2422                     #$log->debug("DELETE   $name");
2423                     $head->{$name} = {
2424                         name => $name,
2425                         revision => $head->{$name}{revision} + 1,
2426                         filehash => "deleted",
2427                         commithash => $commit->{hash},
2428                         modified => $commit->{date},
2429                         author => $commit->{author},
2430                         mode => $git_perms,
2431                     };
2432                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2433                 }
2434                 elsif ( $change eq "M" )
2435                 {
2436                     #$log->debug("MODIFIED $name");
2437                     $head->{$name} = {
2438                         name => $name,
2439                         revision => $head->{$name}{revision} + 1,
2440                         filehash => $hash,
2441                         commithash => $commit->{hash},
2442                         modified => $commit->{date},
2443                         author => $commit->{author},
2444                         mode => $git_perms,
2445                     };
2446                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2447                 }
2448                 elsif ( $change eq "A" )
2449                 {
2450                     #$log->debug("ADDED    $name");
2451                     $head->{$name} = {
2452                         name => $name,
2453                         revision => 1,
2454                         filehash => $hash,
2455                         commithash => $commit->{hash},
2456                         modified => $commit->{date},
2457                         author => $commit->{author},
2458                         mode => $git_perms,
2459                     };
2460                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2461                 }
2462                 else
2463                 {
2464                     $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
2465                     die;
2466                 }
2467             }
2468             close FILELIST;
2469         } else {
2470             # this is used to detect files removed from the repo
2471             my $seen_files = {};
2472
2473             my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2474             local $/ = "\0";
2475             while ( <FILELIST> )
2476             {
2477                 chomp;
2478                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
2479                 {
2480                     die("Couldn't process git-ls-tree line : $_");
2481                 }
2482
2483                 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2484
2485                 $seen_files->{$git_filename} = 1;
2486
2487                 my ( $oldhash, $oldrevision, $oldmode ) = (
2488                     $head->{$git_filename}{filehash},
2489                     $head->{$git_filename}{revision},
2490                     $head->{$git_filename}{mode}
2491                 );
2492
2493                 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2494                 {
2495                     $git_perms = "";
2496                     $git_perms .= "r" if ( $1 & 4 );
2497                     $git_perms .= "w" if ( $1 & 2 );
2498                     $git_perms .= "x" if ( $1 & 1 );
2499                 } else {
2500                     $git_perms = "rw";
2501                 }
2502
2503                 # unless the file exists with the same hash, we need to update it ...
2504                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2505                 {
2506                     my $newrevision = ( $oldrevision or 0 ) + 1;
2507
2508                     $head->{$git_filename} = {
2509                         name => $git_filename,
2510                         revision => $newrevision,
2511                         filehash => $git_hash,
2512                         commithash => $commit->{hash},
2513                         modified => $commit->{date},
2514                         author => $commit->{author},
2515                         mode => $git_perms,
2516                     };
2517
2518
2519                     $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2520                 }
2521             }
2522             close FILELIST;
2523
2524             # Detect deleted files
2525             foreach my $file ( keys %$head )
2526             {
2527                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2528                 {
2529                     $head->{$file}{revision}++;
2530                     $head->{$file}{filehash} = "deleted";
2531                     $head->{$file}{commithash} = $commit->{hash};
2532                     $head->{$file}{modified} = $commit->{date};
2533                     $head->{$file}{author} = $commit->{author};
2534
2535                     $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2536                 }
2537             }
2538             # END : "Detect deleted files"
2539         }
2540
2541
2542         if (exists $commit->{mergemsg})
2543         {
2544             $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
2545         }
2546
2547         $lastpicked = $commit->{hash};
2548
2549         $self->_set_prop("last_commit", $commit->{hash});
2550     }
2551
2552     $self->delete_head();
2553     foreach my $file ( keys %$head )
2554     {
2555         $self->insert_head(
2556             $file,
2557             $head->{$file}{revision},
2558             $head->{$file}{filehash},
2559             $head->{$file}{commithash},
2560             $head->{$file}{modified},
2561             $head->{$file}{author},
2562             $head->{$file}{mode},
2563         );
2564     }
2565     # invalidate the gethead cache
2566     $self->{gethead_cache} = undef;
2567
2568
2569     # Ending exclusive lock here
2570     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2571 }
2572
2573 sub insert_rev
2574 {
2575     my $self = shift;
2576     my $name = shift;
2577     my $revision = shift;
2578     my $filehash = shift;
2579     my $commithash = shift;
2580     my $modified = shift;
2581     my $author = shift;
2582     my $mode = shift;
2583
2584     my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2585     $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2586 }
2587
2588 sub insert_mergelog
2589 {
2590     my $self = shift;
2591     my $key = shift;
2592     my $value = shift;
2593
2594     my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2595     $insert_mergelog->execute($key, $value);
2596 }
2597
2598 sub delete_head
2599 {
2600     my $self = shift;
2601
2602     my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2603     $delete_head->execute();
2604 }
2605
2606 sub insert_head
2607 {
2608     my $self = shift;
2609     my $name = shift;
2610     my $revision = shift;
2611     my $filehash = shift;
2612     my $commithash = shift;
2613     my $modified = shift;
2614     my $author = shift;
2615     my $mode = shift;
2616
2617     my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2618     $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2619 }
2620
2621 sub _headrev
2622 {
2623     my $self = shift;
2624     my $filename = shift;
2625
2626     my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2627     $db_query->execute($filename);
2628     my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2629
2630     return ( $hash, $revision, $mode );
2631 }
2632
2633 sub _get_prop
2634 {
2635     my $self = shift;
2636     my $key = shift;
2637
2638     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2639     $db_query->execute($key);
2640     my ( $value ) = $db_query->fetchrow_array;
2641
2642     return $value;
2643 }
2644
2645 sub _set_prop
2646 {
2647     my $self = shift;
2648     my $key = shift;
2649     my $value = shift;
2650
2651     my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2652     $db_query->execute($value, $key);
2653
2654     unless ( $db_query->rows )
2655     {
2656         $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2657         $db_query->execute($key, $value);
2658     }
2659
2660     return $value;
2661 }
2662
2663 =head2 gethead
2664
2665 =cut
2666
2667 sub gethead
2668 {
2669     my $self = shift;
2670
2671     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2672
2673     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2674     $db_query->execute();
2675
2676     my $tree = [];
2677     while ( my $file = $db_query->fetchrow_hashref )
2678     {
2679         push @$tree, $file;
2680     }
2681
2682     $self->{gethead_cache} = $tree;
2683
2684     return $tree;
2685 }
2686
2687 =head2 getlog
2688
2689 =cut
2690
2691 sub getlog
2692 {
2693     my $self = shift;
2694     my $filename = shift;
2695
2696     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2697     $db_query->execute($filename);
2698
2699     my $tree = [];
2700     while ( my $file = $db_query->fetchrow_hashref )
2701     {
2702         push @$tree, $file;
2703     }
2704
2705     return $tree;
2706 }
2707
2708 =head2 getmeta
2709
2710 This function takes a filename (with path) argument and returns a hashref of
2711 metadata for that file.
2712
2713 =cut
2714
2715 sub getmeta
2716 {
2717     my $self = shift;
2718     my $filename = shift;
2719     my $revision = shift;
2720
2721     my $db_query;
2722     if ( defined($revision) and $revision =~ /^\d+$/ )
2723     {
2724         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2725         $db_query->execute($filename, $revision);
2726     }
2727     elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2728     {
2729         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2730         $db_query->execute($filename, $revision);
2731     } else {
2732         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2733         $db_query->execute($filename);
2734     }
2735
2736     return $db_query->fetchrow_hashref;
2737 }
2738
2739 =head2 commitmessage
2740
2741 this function takes a commithash and returns the commit message for that commit
2742
2743 =cut
2744 sub commitmessage
2745 {
2746     my $self = shift;
2747     my $commithash = shift;
2748
2749     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2750
2751     my $db_query;
2752     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2753     $db_query->execute($commithash);
2754
2755     my ( $message ) = $db_query->fetchrow_array;
2756
2757     if ( defined ( $message ) )
2758     {
2759         $message .= " " if ( $message =~ /\n$/ );
2760         return $message;
2761     }
2762
2763     my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2764     shift @lines while ( $lines[0] =~ /\S/ );
2765     $message = join("",@lines);
2766     $message .= " " if ( $message =~ /\n$/ );
2767     return $message;
2768 }
2769
2770 =head2 gethistory
2771
2772 This function takes a filename (with path) argument and returns an arrayofarrays
2773 containing revision,filehash,commithash ordered by revision descending
2774
2775 =cut
2776 sub gethistory
2777 {
2778     my $self = shift;
2779     my $filename = shift;
2780
2781     my $db_query;
2782     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2783     $db_query->execute($filename);
2784
2785     return $db_query->fetchall_arrayref;
2786 }
2787
2788 =head2 gethistorydense
2789
2790 This function takes a filename (with path) argument and returns an arrayofarrays
2791 containing revision,filehash,commithash ordered by revision descending.
2792
2793 This version of gethistory skips deleted entries -- so it is useful for annotate.
2794 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2795 and other git tools that depend on it.
2796
2797 =cut
2798 sub gethistorydense
2799 {
2800     my $self = shift;
2801     my $filename = shift;
2802
2803     my $db_query;
2804     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2805     $db_query->execute($filename);
2806
2807     return $db_query->fetchall_arrayref;
2808 }
2809
2810 =head2 in_array()
2811
2812 from Array::PAT - mimics the in_array() function
2813 found in PHP. Yuck but works for small arrays.
2814
2815 =cut
2816 sub in_array
2817 {
2818     my ($check, @array) = @_;
2819     my $retval = 0;
2820     foreach my $test (@array){
2821         if($check eq $test){
2822             $retval =  1;
2823         }
2824     }
2825     return $retval;
2826 }
2827
2828 =head2 safe_pipe_capture
2829
2830 an alternative to `command` that allows input to be passed as an array
2831 to work around shell problems with weird characters in arguments
2832
2833 =cut
2834 sub safe_pipe_capture {
2835
2836     my @output;
2837
2838     if (my $pid = open my $child, '-|') {
2839         @output = (<$child>);
2840         close $child or die join(' ',@_).": $! $?";
2841     } else {
2842         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2843     }
2844     return wantarray ? @output : join('',@output);
2845 }
2846
2847
2848 1;