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