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