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

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