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.
8 #### Copyright The Open University UK - 2006.
10 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
11 #### Martin Langhoff <martin@catalyst.net.nz>
14 #### Released under the GNU Public License, version 2.
22 use File::Temp qw/tempdir tempfile/;
25 my $log = GITCVS::log->new();
43 # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
46 #### Definition and mappings of functions ####
50 'Valid-responses' => \&req_Validresponses,
51 'valid-requests' => \&req_validrequests,
52 'Directory' => \&req_Directory,
53 'Entry' => \&req_Entry,
54 'Modified' => \&req_Modified,
55 'Unchanged' => \&req_Unchanged,
56 'Questionable' => \&req_Questionable,
57 'Argument' => \&req_Argument,
58 'Argumentx' => \&req_Argument,
59 'expand-modules' => \&req_expandmodules,
61 'remove' => \&req_remove,
63 'update' => \&req_update,
68 'tag' => \&req_CATCHALL,
69 'status' => \&req_status,
70 'admin' => \&req_CATCHALL,
71 'history' => \&req_CATCHALL,
72 'watchers' => \&req_CATCHALL,
73 'editors' => \&req_CATCHALL,
74 'annotate' => \&req_annotate,
75 'Global_option' => \&req_Globaloption,
76 #'annotate' => \&req_CATCHALL,
79 ##############################################
82 # $state holds all the bits of information the clients sends us that could
83 # potentially be useful when it comes to actually _doing_ something.
85 $log->info("--------------- STARTING -----------------");
87 my $TEMP_DIR = tempdir( CLEANUP => 1 );
88 $log->debug("Temporary directory is '$TEMP_DIR'");
90 # Keep going until the client closes the connection
95 # Check to see if we've seen this method, and call appropiate function.
96 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
98 # use the $methods hash to call the appropriate sub for this command
99 #$log->info("Method : $1");
100 &{$methods->{$1}}($1,$2);
102 # log fatal because we don't understand this function. If this happens
103 # we're fairly screwed because we don't know if the client is expecting
104 # a response. If it is, the client will hang, we'll hang, and the whole
105 # thing will be custard.
106 $log->fatal("Don't understand command $_\n");
107 die("Unknown command $_");
111 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
112 $log->info("--------------- FINISH -----------------");
114 # Magic catchall method.
115 # This is the method that will handle all commands we haven't yet
116 # implemented. It simply sends a warning to the log file indicating a
117 # command that hasn't been implemented has been invoked.
120 my ( $cmd, $data ) = @_;
121 $log->warn("Unhandled command : req_$cmd : $data");
126 # Response expected: no. Tell the server which CVSROOT to use. Note that
127 # pathname is a local directory and not a fully qualified CVSROOT variable.
128 # pathname must already exist; if creating a new root, use the init
129 # request, not Root. pathname does not include the hostname of the server,
130 # how to access the server, etc.; by the time the CVS protocol is in use,
131 # connection, authentication, etc., are already taken care of. The Root
132 # request must be sent only once, and it must be sent before any requests
133 # other than Valid-responses, valid-requests, UseUnchanged, Set or init.
136 my ( $cmd, $data ) = @_;
137 $log->debug("req_Root : $data");
139 $state->{CVSROOT} = $data;
141 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
143 foreach my $line ( `git-var -l` )
145 next unless ( $line =~ /^(.*?)\.(.*?)=(.*)$/ );
149 unless ( defined ( $cfg->{gitcvs}{enabled} ) and $cfg->{gitcvs}{enabled} =~ /^\s*(1|true|yes)\s*$/i )
151 print "E GITCVS emulation needs to be enabled on this repo\n";
152 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
154 print "error 1 GITCVS emulation disabled\n";
157 if ( defined ( $cfg->{gitcvs}{logfile} ) )
159 $log->setfile($cfg->{gitcvs}{logfile});
165 # Global_option option \n
166 # Response expected: no. Transmit one of the global options `-q', `-Q',
167 # `-l', `-t', `-r', or `-n'. option must be one of those strings, no
168 # variations (such as combining of options) are allowed. For graceful
169 # handling of valid-requests, it is probably better to make new global
170 # options separate requests, rather than trying to add them to this
174 my ( $cmd, $data ) = @_;
175 $log->debug("req_Globaloption : $data");
177 # TODO : is this data useful ???
180 # Valid-responses request-list \n
181 # Response expected: no. Tell the server what responses the client will
182 # accept. request-list is a space separated list of tokens.
183 sub req_Validresponses
185 my ( $cmd, $data ) = @_;
186 $log->debug("req_Validrepsonses : $data");
188 # TODO : re-enable this, currently it's not particularly useful
189 #$state->{validresponses} = [ split /\s+/, $data ];
193 # Response expected: yes. Ask the server to send back a Valid-requests
195 sub req_validrequests
197 my ( $cmd, $data ) = @_;
199 $log->debug("req_validrequests");
201 $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
202 $log->debug("SEND : ok");
204 print "Valid-requests " . join(" ",keys %$methods) . "\n";
208 # Directory local-directory \n
209 # Additional data: repository \n. Response expected: no. Tell the server
210 # what directory to use. The repository should be a directory name from a
211 # previous server response. Note that this both gives a default for Entry
212 # and Modified and also for ci and the other commands; normal usage is to
213 # send Directory for each directory in which there will be an Entry or
214 # Modified, and then a final Directory for the original directory, then the
215 # command. The local-directory is relative to the top level at which the
216 # command is occurring (i.e. the last Directory which is sent before the
217 # command); to indicate that top level, `.' should be sent for
221 my ( $cmd, $data ) = @_;
223 my $repository = <STDIN>;
227 $state->{localdir} = $data;
228 $state->{repository} = $repository;
229 $state->{directory} = $repository;
230 $state->{directory} =~ s/^$state->{CVSROOT}\///;
231 $state->{module} = $1 if ($state->{directory} =~ s/^(.*?)(\/|$)//);
232 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
234 $log->debug("req_Directory : localdir=$data repository=$repository directory=$state->{directory} module=$state->{module}");
237 # Entry entry-line \n
238 # Response expected: no. Tell the server what version of a file is on the
239 # local machine. The name in entry-line is a name relative to the directory
240 # most recently specified with Directory. If the user is operating on only
241 # some files in a directory, Entry requests for only those files need be
242 # included. If an Entry request is sent without Modified, Is-modified, or
243 # Unchanged, it means the file is lost (does not exist in the working
244 # directory). If both Entry and one of Modified, Is-modified, or Unchanged
245 # are sent for the same file, Entry must be sent first. For a given file,
246 # one can send Modified, Is-modified, or Unchanged, but not more than one
250 my ( $cmd, $data ) = @_;
252 $log->debug("req_Entry : $data");
254 my @data = split(/\//, $data);
256 $state->{entries}{$state->{directory}.$data[1]} = {
257 revision => $data[2],
258 conflict => $data[3],
260 tag_or_date => $data[5],
265 # Response expected: yes. Add a file or directory. This uses any previous
266 # Argument, Directory, Entry, or Modified requests, if they have been sent.
267 # The last Directory sent specifies the working directory at the time of
268 # the operation. To add a directory, send the directory to be added using
269 # Directory and Argument requests.
272 my ( $cmd, $data ) = @_;
278 foreach my $filename ( @{$state->{args}} )
280 $filename = filecleanup($filename);
282 unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
284 print "E cvs add: nothing known about `$filename'\n";
287 # TODO : check we're not squashing an already existing file
288 if ( defined ( $state->{entries}{$filename}{revision} ) )
290 print "E cvs add: `$filename' has already been entered\n";
295 my ( $filepart, $dirpart ) = filenamesplit($filename);
297 print "E cvs add: scheduling file `$filename' for addition\n";
299 print "Checked-in $dirpart\n";
301 print "/$filepart/0///\n";
306 if ( $addcount == 1 )
308 print "E cvs add: use `cvs commit' to add this file permanently\n";
310 elsif ( $addcount > 1 )
312 print "E cvs add: use `cvs commit' to add these files permanently\n";
319 # Response expected: yes. Remove a file. This uses any previous Argument,
320 # Directory, Entry, or Modified requests, if they have been sent. The last
321 # Directory sent specifies the working directory at the time of the
322 # operation. Note that this request does not actually do anything to the
323 # repository; the only effect of a successful remove request is to supply
324 # the client with a new entries line containing `-' to indicate a removed
325 # file. In fact, the client probably could perform this operation without
326 # contacting the server, although using remove may cause the server to
327 # perform a few more checks. The client sends a subsequent ci request to
328 # actually record the removal in the repository.
331 my ( $cmd, $data ) = @_;
335 # Grab a handle to the SQLite db and do any necessary updates
336 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
339 #$log->debug("add state : " . Dumper($state));
343 foreach my $filename ( @{$state->{args}} )
345 $filename = filecleanup($filename);
347 if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
349 print "E cvs remove: file `$filename' still in working directory\n";
353 my $meta = $updater->getmeta($filename);
354 my $wrev = revparse($filename);
356 unless ( defined ( $wrev ) )
358 print "E cvs remove: nothing known about `$filename'\n";
362 if ( defined($wrev) and $wrev < 0 )
364 print "E cvs remove: file `$filename' already scheduled for removal\n";
368 unless ( $wrev == $meta->{revision} )
370 # TODO : not sure if the format of this message is quite correct.
371 print "E cvs remove: Up to date check failed for `$filename'\n";
376 my ( $filepart, $dirpart ) = filenamesplit($filename);
378 print "E cvs remove: scheduling `$filename' for removal\n";
380 print "Checked-in $dirpart\n";
382 print "/$filepart/-1.$wrev///\n";
389 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
391 elsif ( $rmcount > 1 )
393 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
399 # Modified filename \n
400 # Response expected: no. Additional data: mode, \n, file transmission. Send
401 # the server a copy of one locally modified file. filename is a file within
402 # the most recent directory sent with Directory; it must not contain `/'.
403 # If the user is operating on only some files in a directory, only those
404 # files need to be included. This can also be sent without Entry, if there
405 # is no entry for the file.
408 my ( $cmd, $data ) = @_;
415 # Grab config information
416 my $blocksize = 8192;
417 my $bytesleft = $size;
420 # Get a filehandle/name to write it to
421 my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
423 # Loop over file data writing out to temporary file.
426 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
427 read STDIN, $tmp, $blocksize;
429 $bytesleft -= $blocksize;
434 # Ensure we have something sensible for the file mode
435 if ( $mode =~ /u=(\w+)/ )
442 # Save the file data in $state
443 $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
444 $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
445 $state->{entries}{$state->{directory}.$data}{modified_hash} = `git-hash-object $filename`;
446 $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
448 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
451 # Unchanged filename \n
452 # Response expected: no. Tell the server that filename has not been
453 # modified in the checked out directory. The filename is a file within the
454 # most recent directory sent with Directory; it must not contain `/'.
457 my ( $cmd, $data ) = @_;
459 $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
461 #$log->debug("req_Unchanged : $data");
464 # Questionable filename \n
465 # Response expected: no. Additional data: no.
466 # Tell the server to check whether filename should be ignored,
467 # and if not, next time the server sends responses, send (in
468 # a M response) `?' followed by the directory and filename.
469 # filename must not contain `/'; it needs to be a file in the
470 # directory named by the most recent Directory request.
473 my ( $cmd, $data ) = @_;
475 $state->{entries}{$state->{directory}.$data}{questionable} = 1;
477 #$log->debug("req_Questionable : $data");
481 # Response expected: no. Save argument for use in a subsequent command.
482 # Arguments accumulate until an argument-using command is given, at which
483 # point they are forgotten.
485 # Response expected: no. Append \n followed by text to the current argument
489 my ( $cmd, $data ) = @_;
491 # TODO : Not quite sure how Argument and Argumentx differ, but I assume
492 # it's for multi-line arguments ... somehow ...
494 $log->debug("$cmd : $data");
496 push @{$state->{arguments}}, $data;
500 # Response expected: yes. Expand the modules which are specified in the
501 # arguments. Returns the data in Module-expansion responses. Note that the
502 # server can assume that this is checkout or export, not rtag or rdiff; the
503 # latter do not access the working directory and thus have no need to
504 # expand modules on the client side. Expand may not be the best word for
505 # what this request does. It does not necessarily tell you all the files
506 # contained in a module, for example. Basically it is a way of telling you
507 # which working directories the server needs to know about in order to
508 # handle a checkout of the specified modules. For example, suppose that the
509 # server has a module defined by
510 # aliasmodule -a 1dir
511 # That is, one can check out aliasmodule and it will take 1dir in the
512 # repository and check it out to 1dir in the working directory. Now suppose
513 # the client already has this module checked out and is planning on using
514 # the co request to update it. Without using expand-modules, the client
515 # would have two bad choices: it could either send information about all
516 # working directories under the current directory, which could be
517 # unnecessarily slow, or it could be ignorant of the fact that aliasmodule
518 # stands for 1dir, and neglect to send information for 1dir, which would
519 # lead to incorrect operation. With expand-modules, the client would first
520 # ask for the module to be expanded:
521 sub req_expandmodules
523 my ( $cmd, $data ) = @_;
527 $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
529 unless ( ref $state->{arguments} eq "ARRAY" )
535 foreach my $module ( @{$state->{arguments}} )
537 $log->debug("SEND : Module-expansion $module");
538 print "Module-expansion $module\n";
546 # Response expected: yes. Get files from the repository. This uses any
547 # previous Argument, Directory, Entry, or Modified requests, if they have
548 # been sent. Arguments to this command are module names; the client cannot
549 # know what directories they correspond to except by (1) just sending the
550 # co request, and then seeing what directory names the server sends back in
551 # its responses, and (2) the expand-modules request.
554 my ( $cmd, $data ) = @_;
558 my $module = $state->{args}[0];
559 my $checkout_path = $module;
561 # use the user specified directory if we're given it
562 $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
564 $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
566 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
568 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
570 # Grab a handle to the SQLite db and do any necessary updates
571 my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
574 $checkout_path =~ s|/$||; # get rid of trailing slashes
576 # Eclipse seems to need the Clear-sticky command
577 # to prepare the 'Entries' file for the new directory.
578 print "Clear-sticky $checkout_path/\n";
579 print $state->{CVSROOT} . "/$module/\n";
580 print "Clear-static-directory $checkout_path/\n";
581 print $state->{CVSROOT} . "/$module/\n";
582 print "Clear-sticky $checkout_path/\n"; # yes, twice
583 print $state->{CVSROOT} . "/$module/\n";
584 print "Template $checkout_path/\n";
585 print $state->{CVSROOT} . "/$module/\n";
588 # instruct the client that we're checking out to $checkout_path
589 print "E cvs checkout: Updating $checkout_path\n";
596 my ($dir, $repodir, $remotedir, $seendirs) = @_;
597 my $parent = dirname($dir);
600 $remotedir =~ s|/+$||;
602 $log->debug("announcedir $dir, $repodir, $remotedir" );
604 if ($parent eq '.' || $parent eq './') {
607 # recurse to announce unseen parents first
608 if (length($parent) && !exists($seendirs->{$parent})) {
609 prepdir($parent, $repodir, $remotedir, $seendirs);
611 # Announce that we are going to modify at the parent level
613 print "E cvs checkout: Updating $remotedir/$parent\n";
615 print "E cvs checkout: Updating $remotedir\n";
617 print "Clear-sticky $remotedir/$parent/\n";
618 print "$repodir/$parent/\n";
620 print "Clear-static-directory $remotedir/$dir/\n";
621 print "$repodir/$dir/\n";
622 print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
623 print "$repodir/$parent/\n";
624 print "Template $remotedir/$dir/\n";
625 print "$repodir/$dir/\n";
628 $seendirs->{$dir} = 1;
631 foreach my $git ( @{$updater->gethead} )
633 # Don't want to check out deleted files
634 next if ( $git->{filehash} eq "deleted" );
636 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
638 if (length($git->{dir}) && $git->{dir} ne './'
639 && $git->{dir} ne $lastdir ) {
640 unless (exists($seendirs{$git->{dir}})) {
641 prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
642 $checkout_path, \%seendirs);
643 $lastdir = $git->{dir};
644 $seendirs{$git->{dir}} = 1;
646 print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
649 # modification time of this file
650 print "Mod-time $git->{modified}\n";
652 # print some information to the client
653 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
655 print "M U $checkout_path/$git->{dir}$git->{name}\n";
657 print "M U $checkout_path/$git->{name}\n";
660 # instruct client we're sending a file to put in this path
661 print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
663 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
665 # this is an "entries" line
666 print "/$git->{name}/1.$git->{revision}///\n";
668 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
671 transmitfile($git->{filehash});
680 # Response expected: yes. Actually do a cvs update command. This uses any
681 # previous Argument, Directory, Entry, or Modified requests, if they have
682 # been sent. The last Directory sent specifies the working directory at the
683 # time of the operation. The -I option is not used--files which the client
684 # can decide whether to ignore are not mentioned and the client sends the
685 # Questionable request for others.
688 my ( $cmd, $data ) = @_;
690 $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
695 # It may just be a client exploring the available heads/modukles
696 # in that case, list them as top level directories and leave it
697 # at that. Eclipse uses this technique to offer you a list of
698 # projects (heads in this case) to checkout.
700 if ($state->{module} eq '') {
701 print "E cvs update: Updating .\n";
702 opendir HEADS, $state->{CVSROOT} . '/refs/heads';
703 while (my $head = readdir(HEADS)) {
704 if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
705 print "E cvs update: New directory `$head'\n";
714 # Grab a handle to the SQLite db and do any necessary updates
715 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
719 # if no files were specified, we need to work out what files we should be providing status on ...
720 argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
722 #$log->debug("update state : " . Dumper($state));
724 # foreach file specified on the commandline ...
725 foreach my $filename ( @{$state->{args}} )
727 $filename = filecleanup($filename);
729 # if we have a -C we should pretend we never saw modified stuff
730 if ( exists ( $state->{opt}{C} ) )
732 delete $state->{entries}{$filename}{modified_hash};
733 delete $state->{entries}{$filename}{modified_filename};
734 $state->{entries}{$filename}{unchanged} = 1;
738 if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
740 $meta = $updater->getmeta($filename, $1);
742 $meta = $updater->getmeta($filename);
745 next unless ( $meta->{revision} );
749 my $wrev = revparse($filename);
751 # If the working copy is an old revision, lets get that version too for comparison.
752 if ( defined($wrev) and $wrev != $meta->{revision} )
754 $oldmeta = $updater->getmeta($filename, $wrev);
757 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
759 # Files are up to date if the working copy and repo copy have the same revision,
760 # and the working copy is unmodified _and_ the user hasn't specified -C
761 next if ( defined ( $wrev )
762 and defined($meta->{revision})
763 and $wrev == $meta->{revision}
764 and $state->{entries}{$filename}{unchanged}
765 and not exists ( $state->{opt}{C} ) );
767 # If the working copy and repo copy have the same revision,
768 # but the working copy is modified, tell the client it's modified
769 if ( defined ( $wrev )
770 and defined($meta->{revision})
771 and $wrev == $meta->{revision}
772 and not exists ( $state->{opt}{C} ) )
774 $log->info("Tell the client the file is modified");
776 print "MT fname $filename\n";
777 print "MT newline\n";
781 if ( $meta->{filehash} eq "deleted" )
783 my ( $filepart, $dirpart ) = filenamesplit($filename);
785 $log->info("Removing '$filename' from working copy (no longer in the repo)");
787 print "E cvs update: `$filename' is no longer in the repository\n";
788 print "Removed $dirpart\n";
791 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
792 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} )
794 $log->info("Updating '$filename'");
795 # normal update, just send the new revision (either U=Update, or A=Add, or R=Remove)
796 print "MT +updated\n";
798 print "MT fname $filename\n";
799 print "MT newline\n";
800 print "MT -updated\n";
802 my ( $filepart, $dirpart ) = filenamesplit($filename);
803 $dirpart =~ s/^$state->{directory}//;
805 if ( defined ( $wrev ) )
807 # instruct client we're sending a file to put in this path as a replacement
808 print "Update-existing $dirpart\n";
809 $log->debug("Updating existing file 'Update-existing $dirpart'");
811 # instruct client we're sending a file to put in this path as a new file
812 print "Created $dirpart\n";
813 $log->debug("Creating new file 'Created $dirpart'");
815 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
817 # this is an "entries" line
818 $log->debug("/$filepart/1.$meta->{revision}///");
819 print "/$filepart/1.$meta->{revision}///\n";
822 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
823 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
826 transmitfile($meta->{filehash});
828 $log->info("Updating '$filename'");
829 my ( $filepart, $dirpart ) = filenamesplit($meta->{name});
831 my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
834 my $file_local = $filepart . ".mine";
835 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
836 my $file_old = $filepart . "." . $oldmeta->{revision};
837 transmitfile($oldmeta->{filehash}, $file_old);
838 my $file_new = $filepart . "." . $meta->{revision};
839 transmitfile($meta->{filehash}, $file_new);
841 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
842 $log->info("Merging $file_local, $file_old, $file_new");
844 $log->debug("Temporary directory for merge is $dir");
846 my $return = system("merge", $file_local, $file_old, $file_new);
851 $log->info("Merged successfully");
852 print "M M $filename\n";
853 $log->debug("Update-existing $dirpart");
854 print "Update-existing $dirpart\n";
855 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
856 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
857 $log->debug("/$filepart/1.$meta->{revision}///");
858 print "/$filepart/1.$meta->{revision}///\n";
860 elsif ( $return == 1 )
862 $log->info("Merged with conflicts");
863 print "M C $filename\n";
864 print "Update-existing $dirpart\n";
865 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
866 print "/$filepart/1.$meta->{revision}/+//\n";
870 $log->warn("Merge failed");
875 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
876 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
878 # transmit file, format is single integer on a line by itself (file
879 # size) followed by the file contents
880 # TODO : we should copy files in blocks
881 my $data = `cat $file_local`;
882 $log->debug("File size : " . length($data));
883 print length($data) . "\n";
896 my ( $cmd, $data ) = @_;
900 #$log->debug("State : " . Dumper($state));
902 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
904 if ( -e $state->{CVSROOT} . "/index" )
906 print "error 1 Index already exists in git repo\n";
910 my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
911 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )
913 print "error 1 Lock file '$lockfile' already exists, please try again\n";
917 # Grab a handle to the SQLite db and do any necessary updates
918 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
921 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
922 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
923 $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
925 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
926 $ENV{GIT_INDEX_FILE} = $file_index;
930 # populate the temporary index based
931 system("git-read-tree", $state->{module});
934 die "Error running git-read-tree $state->{module} $file_index $!";
936 $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
939 my @committedfiles = ();
941 # foreach file specified on the commandline ...
942 foreach my $filename ( @{$state->{args}} )
944 $filename = filecleanup($filename);
946 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
948 my $meta = $updater->getmeta($filename);
950 my $wrev = revparse($filename);
952 my ( $filepart, $dirpart ) = filenamesplit($filename);
954 # do a checkout of the file if it part of this tree
956 system('git-checkout-index', '-f', '-u', $filename);
958 die "Error running git-checkout-index -f -u $filename : $!";
964 $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
965 $addflag = 1 unless ( -e $filename );
967 # Do up to date checking
968 unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
970 # fail everything if an up to date check fails
971 print "error 1 Up to date check failed for $filename\n";
978 push @committedfiles, $filename;
979 $log->info("Committing $filename");
981 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
985 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
986 rename $state->{entries}{$filename}{modified_filename},$filename;
988 # Calculate modes to remove
990 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
992 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
993 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
998 $log->info("Removing file '$filename'");
1000 system("git-update-index", "--remove", $filename);
1004 $log->info("Adding file '$filename'");
1005 system("git-update-index", "--add", $filename);
1007 $log->info("Updating file '$filename'");
1008 system("git-update-index", $filename);
1012 unless ( scalar(@committedfiles) > 0 )
1014 print "E No files to commit\n";
1022 my $treehash = `git-write-tree`;
1023 my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
1027 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1029 # write our commit message out if we have one ...
1030 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1031 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1032 print $msg_fh "\n\nvia git-CVS emulator\n";
1035 my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1036 $log->info("Commit hash : $commithash");
1038 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1040 $log->warn("Commit failed (Invalid commit hash)");
1041 print "error 1 Commit failed (unknown reason)\n";
1048 open FILE, ">", "$ENV{GIT_DIR}refs/heads/$state->{module}";
1049 print FILE $commithash;
1054 # foreach file specified on the commandline ...
1055 foreach my $filename ( @committedfiles )
1057 $filename = filecleanup($filename);
1059 my $meta = $updater->getmeta($filename);
1061 my ( $filepart, $dirpart ) = filenamesplit($filename);
1063 $log->debug("Checked-in $dirpart : $filename");
1065 if ( $meta->{filehash} eq "deleted" )
1067 print "Remove-entry $dirpart\n";
1068 print "$filename\n";
1070 print "Checked-in $dirpart\n";
1071 print "$filename\n";
1072 print "/$filepart/1.$meta->{revision}///\n";
1085 my ( $cmd, $data ) = @_;
1089 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1090 #$log->debug("status state : " . Dumper($state));
1092 # Grab a handle to the SQLite db and do any necessary updates
1093 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1096 # if no files were specified, we need to work out what files we should be providing status on ...
1097 argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1099 # foreach file specified on the commandline ...
1100 foreach my $filename ( @{$state->{args}} )
1102 $filename = filecleanup($filename);
1104 my $meta = $updater->getmeta($filename);
1105 my $oldmeta = $meta;
1107 my $wrev = revparse($filename);
1109 # If the working copy is an old revision, lets get that version too for comparison.
1110 if ( defined($wrev) and $wrev != $meta->{revision} )
1112 $oldmeta = $updater->getmeta($filename, $wrev);
1115 # TODO : All possible statuses aren't yet implemented
1117 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1118 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1120 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1121 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1124 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1125 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1127 ( $state->{entries}{$filename}{unchanged}
1128 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1131 # Need checkout if it exists in the repo but doesn't have a working copy
1132 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1134 # Locally modified if working copy and repo copy have the same revision but there are local changes
1135 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1137 # Needs Merge if working copy revision is less than repo copy and there are local changes
1138 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1140 $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1141 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1142 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1143 $status ||= "File had conflicts on merge" if ( 0 );
1145 $status ||= "Unknown";
1147 print "M ===================================================================\n";
1148 print "M File: $filename\tStatus: $status\n";
1149 if ( defined($state->{entries}{$filename}{revision}) )
1151 print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1153 print "M Working revision:\tNo entry for $filename\n";
1155 if ( defined($meta->{revision}) )
1157 print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1158 print "M Sticky Tag:\t\t(none)\n";
1159 print "M Sticky Date:\t\t(none)\n";
1160 print "M Sticky Options:\t\t(none)\n";
1162 print "M Repository revision:\tNo revision control file\n";
1172 my ( $cmd, $data ) = @_;
1176 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1177 #$log->debug("status state : " . Dumper($state));
1179 my ($revision1, $revision2);
1180 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1182 $revision1 = $state->{opt}{r}[0];
1183 $revision2 = $state->{opt}{r}[1];
1185 $revision1 = $state->{opt}{r};
1188 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1189 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1191 $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1193 # Grab a handle to the SQLite db and do any necessary updates
1194 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1197 # if no files were specified, we need to work out what files we should be providing status on ...
1198 argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1200 # foreach file specified on the commandline ...
1201 foreach my $filename ( @{$state->{args}} )
1203 $filename = filecleanup($filename);
1205 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1207 my $wrev = revparse($filename);
1209 # We need _something_ to diff against
1210 next unless ( defined ( $wrev ) );
1212 # if we have a -r switch, use it
1213 if ( defined ( $revision1 ) )
1215 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1216 $meta1 = $updater->getmeta($filename, $revision1);
1217 unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1219 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1222 transmitfile($meta1->{filehash}, $file1);
1224 # otherwise we just use the working copy revision
1227 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1228 $meta1 = $updater->getmeta($filename, $wrev);
1229 transmitfile($meta1->{filehash}, $file1);
1232 # if we have a second -r switch, use it too
1233 if ( defined ( $revision2 ) )
1235 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1236 $meta2 = $updater->getmeta($filename, $revision2);
1238 unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1240 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1244 transmitfile($meta2->{filehash}, $file2);
1246 # otherwise we just use the working copy
1249 $file2 = $state->{entries}{$filename}{modified_filename};
1252 # if we have been given -r, and we don't have a $file2 yet, lets get one
1253 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1255 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1256 $meta2 = $updater->getmeta($filename, $wrev);
1257 transmitfile($meta2->{filehash}, $file2);
1260 # We need to have retrieved something useful
1261 next unless ( defined ( $meta1 ) );
1263 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1264 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1266 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1267 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1270 # Apparently we only show diffs for locally modified files
1271 next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1273 print "M Index: $filename\n";
1274 print "M ===================================================================\n";
1275 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1276 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1277 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1279 foreach my $opt ( keys %{$state->{opt}} )
1281 if ( ref $state->{opt}{$opt} eq "ARRAY" )
1283 foreach my $value ( @{$state->{opt}{$opt}} )
1285 print "-$opt $value ";
1289 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1292 print "$filename\n";
1294 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1296 ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1298 if ( exists $state->{opt}{u} )
1300 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1302 system("diff $file1 $file2 > $filediff");
1317 my ( $cmd, $data ) = @_;
1321 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1322 #$log->debug("log state : " . Dumper($state));
1324 my ( $minrev, $maxrev );
1325 if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1330 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1331 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1332 $minrev++ if ( defined($minrev) and $control eq "::" );
1335 # Grab a handle to the SQLite db and do any necessary updates
1336 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1339 # if no files were specified, we need to work out what files we should be providing status on ...
1340 argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1342 # foreach file specified on the commandline ...
1343 foreach my $filename ( @{$state->{args}} )
1345 $filename = filecleanup($filename);
1347 my $headmeta = $updater->getmeta($filename);
1349 my $revisions = $updater->getlog($filename);
1350 my $totalrevisions = scalar(@$revisions);
1352 if ( defined ( $minrev ) )
1354 $log->debug("Removing revisions less than $minrev");
1355 while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1360 if ( defined ( $maxrev ) )
1362 $log->debug("Removing revisions greater than $maxrev");
1363 while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1369 next unless ( scalar(@$revisions) );
1372 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1373 print "M Working file: $filename\n";
1374 print "M head: 1.$headmeta->{revision}\n";
1375 print "M branch:\n";
1376 print "M locks: strict\n";
1377 print "M access list:\n";
1378 print "M symbolic names:\n";
1379 print "M keyword substitution: kv\n";
1380 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1381 print "M description:\n";
1383 foreach my $revision ( @$revisions )
1385 print "M ----------------------------\n";
1386 print "M revision 1.$revision->{revision}\n";
1387 # reformat the date for log output
1388 $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}) );
1389 $revision->{author} =~ s/\s+.*//;
1390 $revision->{author} =~ s/^(.{8}).*/$1/;
1391 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . "; lines: +2 -3\n";
1392 my $commitmessage = $updater->commitmessage($revision->{commithash});
1393 $commitmessage =~ s/^/M /mg;
1394 print $commitmessage . "\n";
1396 print "M =============================================================================\n";
1404 my ( $cmd, $data ) = @_;
1406 argsplit("annotate");
1408 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1409 #$log->debug("status state : " . Dumper($state));
1411 # Grab a handle to the SQLite db and do any necessary updates
1412 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1415 # if no files were specified, we need to work out what files we should be providing annotate on ...
1416 argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1418 # we'll need a temporary checkout dir
1419 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1420 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1421 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1423 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1424 $ENV{GIT_INDEX_FILE} = $file_index;
1428 # foreach file specified on the commandline ...
1429 foreach my $filename ( @{$state->{args}} )
1431 $filename = filecleanup($filename);
1433 my $meta = $updater->getmeta($filename);
1435 next unless ( $meta->{revision} );
1437 # get all the commits that this file was in
1438 # in dense format -- aka skip dead revisions
1439 my $revisions = $updater->gethistorydense($filename);
1440 my $lastseenin = $revisions->[0][2];
1442 # populate the temporary index based on the latest commit were we saw
1443 # the file -- but do it cheaply without checking out any files
1444 # TODO: if we got a revision from the client, use that instead
1445 # to look up the commithash in sqlite (still good to default to
1446 # the current head as we do now)
1447 system("git-read-tree", $lastseenin);
1450 die "Error running git-read-tree $lastseenin $file_index $!";
1452 $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1454 # do a checkout of the file
1455 system('git-checkout-index', '-f', '-u', $filename);
1457 die "Error running git-checkout-index -f -u $filename : $!";
1460 $log->info("Annotate $filename");
1462 # Prepare a file with the commits from the linearized
1463 # history that annotate should know about. This prevents
1464 # git-jsannotate telling us about commits we are hiding
1467 open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1468 for (my $i=0; $i < @$revisions; $i++)
1470 print ANNOTATEHINTS $revisions->[$i][2];
1471 if ($i+1 < @$revisions) { # have we got a parent?
1472 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1474 print ANNOTATEHINTS "\n";
1477 print ANNOTATEHINTS "\n";
1478 close ANNOTATEHINTS;
1480 my $annotatecmd = 'git-annotate';
1481 open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1482 or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1484 print "E Annotations for $filename\n";
1485 print "E ***************\n";
1486 while ( <ANNOTATE> )
1488 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1490 my $commithash = $1;
1492 unless ( defined ( $metadata->{$commithash} ) )
1494 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1495 $metadata->{$commithash}{author} =~ s/\s+.*//;
1496 $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1497 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1499 printf("M 1.%-5d (%-8s %10s): %s\n",
1500 $metadata->{$commithash}{revision},
1501 $metadata->{$commithash}{author},
1502 $metadata->{$commithash}{modified},
1506 $log->warn("Error in annotate output! LINE: $_");
1507 print "E Annotate error \n";
1514 # done; get out of the tempdir
1521 # This method takes the state->{arguments} array and produces two new arrays.
1522 # The first is $state->{args} which is everything before the '--' argument, and
1523 # the second is $state->{files} which is everything after it.
1526 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1530 $state->{args} = [];
1531 $state->{files} = [];
1534 if ( defined($type) )
1537 $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" );
1538 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1539 $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" );
1540 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1541 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1542 $opt = { k => 1, m => 1 } if ( $type eq "add" );
1543 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1544 $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" );
1547 while ( scalar ( @{$state->{arguments}} ) > 0 )
1549 my $arg = shift @{$state->{arguments}};
1551 next if ( $arg eq "--" );
1552 next unless ( $arg =~ /\S/ );
1554 # if the argument looks like a switch
1555 if ( $arg =~ /^-(\w)(.*)/ )
1557 # if it's a switch that takes an argument
1560 # If this switch has already been provided
1561 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1563 $state->{opt}{$1} = [ $state->{opt}{$1} ];
1564 if ( length($2) > 0 )
1566 push @{$state->{opt}{$1}},$2;
1568 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1571 # if there's extra data in the arg, use that as the argument for the switch
1572 if ( length($2) > 0 )
1574 $state->{opt}{$1} = $2;
1576 $state->{opt}{$1} = shift @{$state->{arguments}};
1580 $state->{opt}{$1} = undef;
1585 push @{$state->{args}}, $arg;
1593 foreach my $value ( @{$state->{arguments}} )
1595 if ( $value eq "--" )
1600 push @{$state->{args}}, $value if ( $mode == 0 );
1601 push @{$state->{files}}, $value if ( $mode == 1 );
1606 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1609 my $updater = shift;
1611 $state->{args} = [];
1613 foreach my $file ( @{$updater->gethead} )
1615 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1616 next unless ( $file->{name} =~ s/^$state->{directory}// );
1617 push @{$state->{args}}, $file->{name};
1621 # This method cleans up the $state variable after a command that uses arguments has run
1624 $state->{files} = [];
1625 $state->{args} = [];
1626 $state->{arguments} = [];
1627 $state->{entries} = {};
1632 my $filename = shift;
1634 return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1636 return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1637 return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1642 # This method takes a file hash and does a CVS "file transfer" which transmits the
1643 # size of the file, and then the file contents.
1644 # If a second argument $targetfile is given, the file is instead written out to
1645 # a file by the name of $targetfile
1648 my $filehash = shift;
1649 my $targetfile = shift;
1651 if ( defined ( $filehash ) and $filehash eq "deleted" )
1653 $log->warn("filehash is 'deleted'");
1657 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1659 my $type = `git-cat-file -t $filehash`;
1662 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1664 my $size = `git-cat-file -s $filehash`;
1667 $log->debug("transmitfile($filehash) size=$size, type=$type");
1669 if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1671 if ( defined ( $targetfile ) )
1673 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1674 print NEWFILE $_ while ( <$fh> );
1678 print while ( <$fh> );
1680 close $fh or die ("Couldn't close filehandle for transmitfile()");
1682 die("Couldn't execute git-cat-file");
1686 # This method takes a file name, and returns ( $dirpart, $filepart ) which
1687 # refers to the directory porition and the file portion of the filename
1691 my $filename = shift;
1693 my ( $filepart, $dirpart ) = ( $filename, "." );
1694 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1697 return ( $filepart, $dirpart );
1702 my $filename = shift;
1704 return undef unless(defined($filename));
1705 if ( $filename =~ /^\// )
1707 print "E absolute filenames '$filename' not supported by server\n";
1711 $filename =~ s/^\.\///g;
1712 $filename = $state->{directory} . $filename;
1717 package GITCVS::log;
1720 #### Copyright The Open University UK - 2006.
1722 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
1723 #### Martin Langhoff <martin@catalyst.net.nz>
1736 This module provides very crude logging with a similar interface to
1745 Creates a new log object, optionally you can specify a filename here to
1746 indicate the file to log to. If no log file is specified, you can specifiy one
1747 later with method setfile, or indicate you no longer want logging with method
1750 Until one of these methods is called, all log calls will buffer messages ready
1757 my $filename = shift;
1761 bless $self, $class;
1763 if ( defined ( $filename ) )
1765 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1773 This methods takes a filename, and attempts to open that file as the log file.
1774 If successful, all buffered data is written out to the file, and any further
1775 logging is written directly to the file.
1781 my $filename = shift;
1783 if ( defined ( $filename ) )
1785 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1788 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1790 while ( my $line = shift @{$self->{buffer}} )
1792 print {$self->{fh}} $line;
1798 This method indicates no logging is going to be used. It flushes any entries in
1799 the internal buffer, and sets a flag to ensure no further data is put there.
1808 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1810 $self->{buffer} = [];
1815 Internal method. Returns true if the log file is open, false otherwise.
1822 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
1826 =head2 debug info warn fatal
1828 These four methods are wrappers to _log. They provide the actual interface for
1832 sub debug { my $self = shift; $self->_log("debug", @_); }
1833 sub info { my $self = shift; $self->_log("info" , @_); }
1834 sub warn { my $self = shift; $self->_log("warn" , @_); }
1835 sub fatal { my $self = shift; $self->_log("fatal", @_); }
1839 This is an internal method called by the logging functions. It generates a
1840 timestamp and pushes the logged line either to file, or internal buffer.
1848 return if ( $self->{nolog} );
1850 my @time = localtime;
1851 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
1861 if ( $self->_logopen )
1863 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
1865 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
1871 This method simply closes the file handle if one is open
1878 if ( $self->_logopen )
1884 package GITCVS::updater;
1887 #### Copyright The Open University UK - 2006.
1889 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
1890 #### Martin Langhoff <martin@catalyst.net.nz>
1912 die "Need to specify a git repository" unless ( defined($config) and -d $config );
1913 die "Need to specify a module" unless ( defined($module) );
1915 $class = ref($class) || $class;
1919 bless $self, $class;
1921 $self->{dbdir} = $config . "/";
1922 die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
1924 $self->{module} = $module;
1925 $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
1927 $self->{git_path} = $config . "/";
1929 $self->{log} = $log;
1931 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
1933 $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
1935 $self->{tables} = {};
1936 foreach my $table ( $self->{dbh}->tables )
1940 $self->{tables}{$table} = 1;
1943 # Construct the revision table if required
1944 unless ( $self->{tables}{revision} )
1947 CREATE TABLE revision (
1949 revision INTEGER NOT NULL,
1950 filehash TEXT NOT NULL,
1951 commithash TEXT NOT NULL,
1952 author TEXT NOT NULL,
1953 modified TEXT NOT NULL,
1959 # Construct the revision table if required
1960 unless ( $self->{tables}{head} )
1965 revision INTEGER NOT NULL,
1966 filehash TEXT NOT NULL,
1967 commithash TEXT NOT NULL,
1968 author TEXT NOT NULL,
1969 modified TEXT NOT NULL,
1975 # Construct the properties table if required
1976 unless ( $self->{tables}{properties} )
1979 CREATE TABLE properties (
1980 key TEXT NOT NULL PRIMARY KEY,
1986 # Construct the commitmsgs table if required
1987 unless ( $self->{tables}{commitmsgs} )
1990 CREATE TABLE commitmsgs (
1991 key TEXT NOT NULL PRIMARY KEY,
2007 # first lets get the commit list
2008 $ENV{GIT_DIR} = $self->{git_path};
2010 # prepare database queries
2011 my $db_insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2012 my $db_insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2013 my $db_delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2014 my $db_insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2016 my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2017 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2019 die("Invalid module '$self->{module}'");
2024 my $lastcommit = $self->_get_prop("last_commit");
2026 # Start exclusive lock here...
2027 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2029 # TODO: log processing is memory bound
2030 # if we can parse into a 2nd file that is in reverse order
2031 # we can probably do something really efficient
2032 my @git_log_params = ('--parents', '--topo-order');
2034 if (defined $lastcommit) {
2035 push @git_log_params, "$lastcommit..$self->{module}";
2037 push @git_log_params, $self->{module};
2039 open(GITLOG, '-|', 'git-log', @git_log_params) or die "Cannot call git-log: $!";
2048 if (m/^commit\s+(.*)$/) {
2049 # on ^commit lines put the just seen commit in the stack
2050 # and prime things for the next one
2053 unshift @commits, \%copy;
2056 my @parents = split(m/\s+/, $1);
2057 $commit{hash} = shift @parents;
2058 $commit{parents} = \@parents;
2059 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2060 # on rfc822-like lines seen before we see any message,
2061 # lowercase the entry and put it in the hash as key-value
2062 $commit{lc($1)} = $2;
2064 # message lines - skip initial empty line
2065 # and trim whitespace
2066 if (!exists($commit{message}) && m/^\s*$/) {
2067 # define it to mark the end of headers
2068 $commit{message} = '';
2071 s/^\s+//; s/\s+$//; # trim ws
2072 $commit{message} .= $_ . "\n";
2077 unshift @commits, \%commit if ( keys %commit );
2079 # Now all the commits are in the @commits bucket
2080 # ordered by time DESC. for each commit that needs processing,
2081 # determine whether it's following the last head we've seen or if
2082 # it's on its own branch, grab a file list, and add whatever's changed
2083 # NOTE: $lastcommit refers to the last commit from previous run
2084 # $lastpicked is the last commit we picked in this run
2087 if (defined $lastcommit) {
2088 $lastpicked = $lastcommit;
2091 my $committotal = scalar(@commits);
2092 my $commitcount = 0;
2094 # Load the head table into $head (for cached lookups during the update process)
2095 foreach my $file ( @{$self->gethead()} )
2097 $head->{$file->{name}} = $file;
2100 foreach my $commit ( @commits )
2102 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2103 if (defined $lastpicked)
2105 if (!in_array($lastpicked, @{$commit->{parents}}))
2107 # skip, we'll see this delta
2108 # as part of a merge later
2109 # warn "skipping off-track $commit->{hash}\n";
2111 } elsif (@{$commit->{parents}} > 1) {
2112 # it is a merge commit, for each parent that is
2113 # not $lastpicked, see if we can get a log
2114 # from the merge-base to that parent to put it
2115 # in the message as a merge summary.
2116 my @parents = @{$commit->{parents}};
2117 foreach my $parent (@parents) {
2118 # git-merge-base can potentially (but rarely) throw
2119 # several candidate merge bases. let's assume
2120 # that the first one is the best one.
2121 if ($parent eq $lastpicked) {
2124 open my $p, 'git-merge-base '. $lastpicked . ' '
2126 my @output = (<$p>);
2128 my $base = join('', @output);
2132 # print "want to log between $base $parent \n";
2133 open(GITLOG, '-|', 'git-log', "$base..$parent")
2134 or die "Cannot call git-log: $!";
2138 if (!defined $mergedhash) {
2139 if (m/^commit\s+(.+)$/) {
2145 # grab the first line that looks non-rfc822
2146 # aka has content after leading space
2147 if (m/^\s+(\S.*)$/) {
2149 $title = substr($title,0,100); # truncate
2150 unshift @merged, "$mergedhash $title";
2157 $commit->{mergemsg} = $commit->{message};
2158 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2159 foreach my $summary (@merged) {
2160 $commit->{mergemsg} .= "\t$summary\n";
2162 $commit->{mergemsg} .= "\n\n";
2163 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2170 # convert the date to CVS-happy format
2171 $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2173 if ( defined ( $lastpicked ) )
2175 my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2176 while ( <FILELIST> )
2178 unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o )
2180 die("Couldn't process git-diff-tree line : $_");
2183 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2186 $git_perms .= "r" if ( $1 & 4 );
2187 $git_perms .= "w" if ( $1 & 2 );
2188 $git_perms .= "x" if ( $1 & 1 );
2189 $git_perms = "rw" if ( $git_perms eq "" );
2193 #$log->debug("DELETE $4");
2196 revision => $head->{$4}{revision} + 1,
2197 filehash => "deleted",
2198 commithash => $commit->{hash},
2199 modified => $commit->{date},
2200 author => $commit->{author},
2203 $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2207 #$log->debug("MODIFIED $4");
2210 revision => $head->{$4}{revision} + 1,
2212 commithash => $commit->{hash},
2213 modified => $commit->{date},
2214 author => $commit->{author},
2217 $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2221 #$log->debug("ADDED $4");
2226 commithash => $commit->{hash},
2227 modified => $commit->{date},
2228 author => $commit->{author},
2231 $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2235 $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2241 # this is used to detect files removed from the repo
2242 my $seen_files = {};
2244 my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2245 while ( <FILELIST> )
2247 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2249 die("Couldn't process git-ls-tree line : $_");
2252 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2254 $seen_files->{$git_filename} = 1;
2256 my ( $oldhash, $oldrevision, $oldmode ) = (
2257 $head->{$git_filename}{filehash},
2258 $head->{$git_filename}{revision},
2259 $head->{$git_filename}{mode}
2262 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2265 $git_perms .= "r" if ( $1 & 4 );
2266 $git_perms .= "w" if ( $1 & 2 );
2267 $git_perms .= "x" if ( $1 & 1 );
2272 # unless the file exists with the same hash, we need to update it ...
2273 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2275 my $newrevision = ( $oldrevision or 0 ) + 1;
2277 $head->{$git_filename} = {
2278 name => $git_filename,
2279 revision => $newrevision,
2280 filehash => $git_hash,
2281 commithash => $commit->{hash},
2282 modified => $commit->{date},
2283 author => $commit->{author},
2288 $db_insert_rev->execute($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2293 # Detect deleted files
2294 foreach my $file ( keys %$head )
2296 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2298 $head->{$file}{revision}++;
2299 $head->{$file}{filehash} = "deleted";
2300 $head->{$file}{commithash} = $commit->{hash};
2301 $head->{$file}{modified} = $commit->{date};
2302 $head->{$file}{author} = $commit->{author};
2304 $db_insert_rev->execute($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2307 # END : "Detect deleted files"
2311 if (exists $commit->{mergemsg})
2313 $db_insert_mergelog->execute($commit->{hash}, $commit->{mergemsg});
2316 $lastpicked = $commit->{hash};
2318 $self->_set_prop("last_commit", $commit->{hash});
2321 $db_delete_head->execute();
2322 foreach my $file ( keys %$head )
2324 $db_insert_head->execute(
2326 $head->{$file}{revision},
2327 $head->{$file}{filehash},
2328 $head->{$file}{commithash},
2329 $head->{$file}{modified},
2330 $head->{$file}{author},
2331 $head->{$file}{mode},
2334 # invalidate the gethead cache
2335 $self->{gethead_cache} = undef;
2338 # Ending exclusive lock here
2339 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2345 my $filename = shift;
2347 my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2348 $db_query->execute($filename);
2349 my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2351 return ( $hash, $revision, $mode );
2359 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2360 $db_query->execute($key);
2361 my ( $value ) = $db_query->fetchrow_array;
2372 my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2373 $db_query->execute($value, $key);
2375 unless ( $db_query->rows )
2377 $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2378 $db_query->execute($key, $value);
2392 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2394 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2395 $db_query->execute();
2398 while ( my $file = $db_query->fetchrow_hashref )
2403 $self->{gethead_cache} = $tree;
2415 my $filename = shift;
2417 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2418 $db_query->execute($filename);
2421 while ( my $file = $db_query->fetchrow_hashref )
2431 This function takes a filename (with path) argument and returns a hashref of
2432 metadata for that file.
2439 my $filename = shift;
2440 my $revision = shift;
2443 if ( defined($revision) and $revision =~ /^\d+$/ )
2445 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2446 $db_query->execute($filename, $revision);
2448 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2450 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2451 $db_query->execute($filename, $revision);
2453 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2454 $db_query->execute($filename);
2457 return $db_query->fetchrow_hashref;
2460 =head2 commitmessage
2462 this function takes a commithash and returns the commit message for that commit
2468 my $commithash = shift;
2470 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2473 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2474 $db_query->execute($commithash);
2476 my ( $message ) = $db_query->fetchrow_array;
2478 if ( defined ( $message ) )
2480 $message .= " " if ( $message =~ /\n$/ );
2484 my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2485 shift @lines while ( $lines[0] =~ /\S/ );
2486 $message = join("",@lines);
2487 $message .= " " if ( $message =~ /\n$/ );
2493 This function takes a filename (with path) argument and returns an arrayofarrays
2494 containing revision,filehash,commithash ordered by revision descending
2500 my $filename = shift;
2503 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2504 $db_query->execute($filename);
2506 return $db_query->fetchall_arrayref;
2509 =head2 gethistorydense
2511 This function takes a filename (with path) argument and returns an arrayofarrays
2512 containing revision,filehash,commithash ordered by revision descending.
2514 This version of gethistory skips deleted entries -- so it is useful for annotate.
2515 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2516 and other git tools that depend on it.
2522 my $filename = shift;
2525 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2526 $db_query->execute($filename);
2528 return $db_query->fetchall_arrayref;
2533 from Array::PAT - mimics the in_array() function
2534 found in PHP. Yuck but works for small arrays.
2539 my ($check, @array) = @_;
2541 foreach my $test (@array){
2542 if($check eq $test){
2549 =head2 safe_pipe_capture
2551 an alterative to `command` that allows input to be passed as an array
2552 to work around shell problems with weird characters in arguments
2555 sub safe_pipe_capture {
2559 if (my $pid = open my $child, '-|') {
2560 @output = (<$child>);
2561 close $child or die join(' ',@_).": $! $?";
2563 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2565 return wantarray ? @output : join('',@output);