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