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