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