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