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

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