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