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