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 # if we are called with a pserver argument,
91 # deal with the authentication cat before entering the
93 if (@ARGV && $ARGV[0] eq 'pserver') {
94 my $line = <STDIN
>; chomp $line;
95 unless( $line eq 'BEGIN AUTH REQUEST') {
96 die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
98 $line = <STDIN
>; chomp $line;
99 req_Root
('root', $line) # reuse Root
100 or die "E Invalid root $line \n";
101 $line = <STDIN
>; chomp $line;
102 unless ($line eq 'anonymous') {
103 print "E Only anonymous user allowed via pserver\n";
104 print "I HATE YOU\n";
106 $line = <STDIN
>; chomp $line; # validate the password?
107 $line = <STDIN
>; chomp $line;
108 unless ($line eq 'END AUTH REQUEST') {
109 die "E Do not understand $line -- expecting END AUTH REQUEST\n";
111 print "I LOVE YOU\n";
112 # and now back to our regular programme...
115 # Keep going until the client closes the connection
120 # Check to see if we've seen this method, and call appropriate function.
121 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
123 # use the $methods hash to call the appropriate sub for this command
124 #$log->info("Method : $1");
125 &{$methods->{$1}}($1,$2);
127 # log fatal because we don't understand this function. If this happens
128 # we're fairly screwed because we don't know if the client is expecting
129 # a response. If it is, the client will hang, we'll hang, and the whole
130 # thing will be custard.
131 $log->fatal("Don't understand command $_\n");
132 die("Unknown command $_");
136 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
137 $log->info("--------------- FINISH -----------------");
139 # Magic catchall method.
140 # This is the method that will handle all commands we haven't yet
141 # implemented. It simply sends a warning to the log file indicating a
142 # command that hasn't been implemented has been invoked.
145 my ( $cmd, $data ) = @_;
146 $log->warn("Unhandled command : req_$cmd : $data");
151 # Response expected: no. Tell the server which CVSROOT to use. Note that
152 # pathname is a local directory and not a fully qualified CVSROOT variable.
153 # pathname must already exist; if creating a new root, use the init
154 # request, not Root. pathname does not include the hostname of the server,
155 # how to access the server, etc.; by the time the CVS protocol is in use,
156 # connection, authentication, etc., are already taken care of. The Root
157 # request must be sent only once, and it must be sent before any requests
158 # other than Valid-responses, valid-requests, UseUnchanged, Set or init.
161 my ( $cmd, $data ) = @_;
162 $log->debug("req_Root : $data");
164 $state->{CVSROOT
} = $data;
166 $ENV{GIT_DIR
} = $state->{CVSROOT
} . "/";
167 unless (-d
$ENV{GIT_DIR
} && -e
$ENV{GIT_DIR
}.'HEAD') {
168 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
170 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
174 my @gitvars = `git-repo-config -l`;
176 print "E problems executing git-repo-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
178 print "error 1 - problem executing git-repo-config\n";
181 foreach my $line ( @gitvars )
183 next unless ( $line =~ /^(.*?)\.(.*?)=(.*)$/ );
187 unless ( defined ( $cfg->{gitcvs
}{enabled
} ) and $cfg->{gitcvs
}{enabled
} =~ /^\s*(1|true|yes)\s*$/i )
189 print "E GITCVS emulation needs to be enabled on this repo\n";
190 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
192 print "error 1 GITCVS emulation disabled\n";
196 if ( defined ( $cfg->{gitcvs
}{logfile
} ) )
198 $log->setfile($cfg->{gitcvs
}{logfile
});
206 # Global_option option \n
207 # Response expected: no. Transmit one of the global options `-q', `-Q',
208 # `-l', `-t', `-r', or `-n'. option must be one of those strings, no
209 # variations (such as combining of options) are allowed. For graceful
210 # handling of valid-requests, it is probably better to make new global
211 # options separate requests, rather than trying to add them to this
215 my ( $cmd, $data ) = @_;
216 $log->debug("req_Globaloption : $data");
217 $state->{globaloptions
}{$data} = 1;
220 # Valid-responses request-list \n
221 # Response expected: no. Tell the server what responses the client will
222 # accept. request-list is a space separated list of tokens.
223 sub req_Validresponses
225 my ( $cmd, $data ) = @_;
226 $log->debug("req_Validresponses : $data");
228 # TODO : re-enable this, currently it's not particularly useful
229 #$state->{validresponses} = [ split /\s+/, $data ];
233 # Response expected: yes. Ask the server to send back a Valid-requests
235 sub req_validrequests
237 my ( $cmd, $data ) = @_;
239 $log->debug("req_validrequests");
241 $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
242 $log->debug("SEND : ok");
244 print "Valid-requests " . join(" ",keys %$methods) . "\n";
248 # Directory local-directory \n
249 # Additional data: repository \n. Response expected: no. Tell the server
250 # what directory to use. The repository should be a directory name from a
251 # previous server response. Note that this both gives a default for Entry
252 # and Modified and also for ci and the other commands; normal usage is to
253 # send Directory for each directory in which there will be an Entry or
254 # Modified, and then a final Directory for the original directory, then the
255 # command. The local-directory is relative to the top level at which the
256 # command is occurring (i.e. the last Directory which is sent before the
257 # command); to indicate that top level, `.' should be sent for
261 my ( $cmd, $data ) = @_;
263 my $repository = <STDIN
>;
267 $state->{localdir
} = $data;
268 $state->{repository
} = $repository;
269 $state->{path
} = $repository;
270 $state->{path
} =~ s/^$state->{CVSROOT}\///;
271 $state->{module
} = $1 if ($state->{path
} =~ s/^(.*?)(\/|$)//);
272 $state->{path
} .= "/" if ( $state->{path
} =~ /\S
/ );
274 $state->{directory
} = $state->{localdir
};
275 $state->{directory
} = "" if ( $state->{directory
} eq "." );
276 $state->{directory
} .= "/" if ( $state->{directory
} =~ /\S
/ );
278 if ( not defined($state->{prependdir
}) and $state->{localdir
} eq "." and $state->{path
} =~ /\S/ )
280 $log->info("Setting prepend to '$state->{path}'");
281 $state->{prependdir
} = $state->{path
};
282 foreach my $entry ( keys %{$state->{entries
}} )
284 $state->{entries
}{$state->{prependdir
} . $entry} = $state->{entries
}{$entry};
285 delete $state->{entries
}{$entry};
289 if ( defined ( $state->{prependdir
} ) )
291 $log->debug("Prepending '$state->{prependdir}' to state|directory");
292 $state->{directory
} = $state->{prependdir
} . $state->{directory
}
295 $log->debug("req_Directory : localdir=$data repository=$repository directory=$state->{directory} module=$state->{module}");
298 # Entry entry-line \n
299 # Response expected: no. Tell the server what version of a file is on the
300 # local machine. The name in entry-line is a name relative to the directory
301 # most recently specified with Directory. If the user is operating on only
302 # some files in a directory, Entry requests for only those files need be
303 # included. If an Entry request is sent without Modified, Is-modified, or
304 # Unchanged, it means the file is lost (does not exist in the working
305 # directory). If both Entry and one of Modified, Is-modified, or Unchanged
306 # are sent for the same file, Entry must be sent first. For a given file,
307 # one can send Modified, Is-modified, or Unchanged, but not more than one
311 my ( $cmd, $data ) = @_;
313 #$log->debug("req_Entry : $data");
315 my @data = split(/\//, $data);
317 $state->{entries
}{$state->{directory
}.$data[1]} = {
318 revision
=> $data[2],
319 conflict
=> $data[3],
321 tag_or_date
=> $data[5],
324 $log->info("Received entry line '$data' => '" . $state->{directory
} . $data[1] . "'");
327 # Questionable filename \n
328 # Response expected: no. Additional data: no. Tell the server to check
329 # whether filename should be ignored, and if not, next time the server
330 # sends responses, send (in a M response) `?' followed by the directory and
331 # filename. filename must not contain `/'; it needs to be a file in the
332 # directory named by the most recent Directory request.
335 my ( $cmd, $data ) = @_;
337 $log->debug("req_Questionable : $data");
338 $state->{entries
}{$state->{directory
}.$data}{questionable
} = 1;
342 # Response expected: yes. Add a file or directory. This uses any previous
343 # Argument, Directory, Entry, or Modified requests, if they have been sent.
344 # The last Directory sent specifies the working directory at the time of
345 # the operation. To add a directory, send the directory to be added using
346 # Directory and Argument requests.
349 my ( $cmd, $data ) = @_;
355 foreach my $filename ( @
{$state->{args
}} )
357 $filename = filecleanup
($filename);
359 unless ( defined ( $state->{entries
}{$filename}{modified_filename
} ) )
361 print "E cvs add: nothing known about `$filename'\n";
364 # TODO : check we're not squashing an already existing file
365 if ( defined ( $state->{entries
}{$filename}{revision
} ) )
367 print "E cvs add: `$filename' has already been entered\n";
371 my ( $filepart, $dirpart ) = filenamesplit
($filename, 1);
373 print "E cvs add: scheduling file `$filename' for addition\n";
375 print "Checked-in $dirpart\n";
377 print "/$filepart/0///\n";
382 if ( $addcount == 1 )
384 print "E cvs add: use `cvs commit' to add this file permanently\n";
386 elsif ( $addcount > 1 )
388 print "E cvs add: use `cvs commit' to add these files permanently\n";
395 # Response expected: yes. Remove a file. This uses any previous Argument,
396 # Directory, Entry, or Modified requests, if they have been sent. The last
397 # Directory sent specifies the working directory at the time of the
398 # operation. Note that this request does not actually do anything to the
399 # repository; the only effect of a successful remove request is to supply
400 # the client with a new entries line containing `-' to indicate a removed
401 # file. In fact, the client probably could perform this operation without
402 # contacting the server, although using remove may cause the server to
403 # perform a few more checks. The client sends a subsequent ci request to
404 # actually record the removal in the repository.
407 my ( $cmd, $data ) = @_;
411 # Grab a handle to the SQLite db and do any necessary updates
412 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
415 #$log->debug("add state : " . Dumper($state));
419 foreach my $filename ( @
{$state->{args
}} )
421 $filename = filecleanup
($filename);
423 if ( defined ( $state->{entries
}{$filename}{unchanged
} ) or defined ( $state->{entries
}{$filename}{modified_filename
} ) )
425 print "E cvs remove: file `$filename' still in working directory\n";
429 my $meta = $updater->getmeta($filename);
430 my $wrev = revparse
($filename);
432 unless ( defined ( $wrev ) )
434 print "E cvs remove: nothing known about `$filename'\n";
438 if ( defined($wrev) and $wrev < 0 )
440 print "E cvs remove: file `$filename' already scheduled for removal\n";
444 unless ( $wrev == $meta->{revision
} )
446 # TODO : not sure if the format of this message is quite correct.
447 print "E cvs remove: Up to date check failed for `$filename'\n";
452 my ( $filepart, $dirpart ) = filenamesplit
($filename, 1);
454 print "E cvs remove: scheduling `$filename' for removal\n";
456 print "Checked-in $dirpart\n";
458 print "/$filepart/-1.$wrev///\n";
465 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
467 elsif ( $rmcount > 1 )
469 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
475 # Modified filename \n
476 # Response expected: no. Additional data: mode, \n, file transmission. Send
477 # the server a copy of one locally modified file. filename is a file within
478 # the most recent directory sent with Directory; it must not contain `/'.
479 # If the user is operating on only some files in a directory, only those
480 # files need to be included. This can also be sent without Entry, if there
481 # is no entry for the file.
484 my ( $cmd, $data ) = @_;
491 # Grab config information
492 my $blocksize = 8192;
493 my $bytesleft = $size;
496 # Get a filehandle/name to write it to
497 my ( $fh, $filename ) = tempfile
( DIR
=> $TEMP_DIR );
499 # Loop over file data writing out to temporary file.
502 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
503 read STDIN
, $tmp, $blocksize;
505 $bytesleft -= $blocksize;
510 # Ensure we have something sensible for the file mode
511 if ( $mode =~ /u=(\w+)/ )
518 # Save the file data in $state
519 $state->{entries
}{$state->{directory
}.$data}{modified_filename
} = $filename;
520 $state->{entries
}{$state->{directory
}.$data}{modified_mode
} = $mode;
521 $state->{entries
}{$state->{directory
}.$data}{modified_hash
} = `git-hash-object $filename`;
522 $state->{entries
}{$state->{directory
}.$data}{modified_hash
} =~ s/\s.*$//s;
524 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
527 # Unchanged filename \n
528 # Response expected: no. Tell the server that filename has not been
529 # modified in the checked out directory. The filename is a file within the
530 # most recent directory sent with Directory; it must not contain `/'.
533 my ( $cmd, $data ) = @_;
535 $state->{entries
}{$state->{directory
}.$data}{unchanged
} = 1;
537 #$log->debug("req_Unchanged : $data");
541 # Response expected: no. Save argument for use in a subsequent command.
542 # Arguments accumulate until an argument-using command is given, at which
543 # point they are forgotten.
545 # Response expected: no. Append \n followed by text to the current argument
549 my ( $cmd, $data ) = @_;
551 # TODO : Not quite sure how Argument and Argumentx differ, but I assume
552 # it's for multi-line arguments ... somehow ...
554 $log->debug("$cmd : $data");
556 push @
{$state->{arguments
}}, $data;
560 # Response expected: yes. Expand the modules which are specified in the
561 # arguments. Returns the data in Module-expansion responses. Note that the
562 # server can assume that this is checkout or export, not rtag or rdiff; the
563 # latter do not access the working directory and thus have no need to
564 # expand modules on the client side. Expand may not be the best word for
565 # what this request does. It does not necessarily tell you all the files
566 # contained in a module, for example. Basically it is a way of telling you
567 # which working directories the server needs to know about in order to
568 # handle a checkout of the specified modules. For example, suppose that the
569 # server has a module defined by
570 # aliasmodule -a 1dir
571 # That is, one can check out aliasmodule and it will take 1dir in the
572 # repository and check it out to 1dir in the working directory. Now suppose
573 # the client already has this module checked out and is planning on using
574 # the co request to update it. Without using expand-modules, the client
575 # would have two bad choices: it could either send information about all
576 # working directories under the current directory, which could be
577 # unnecessarily slow, or it could be ignorant of the fact that aliasmodule
578 # stands for 1dir, and neglect to send information for 1dir, which would
579 # lead to incorrect operation. With expand-modules, the client would first
580 # ask for the module to be expanded:
581 sub req_expandmodules
583 my ( $cmd, $data ) = @_;
587 $log->debug("req_expandmodules : " . ( defined($data) ?
$data : "[NULL]" ) );
589 unless ( ref $state->{arguments
} eq "ARRAY" )
595 foreach my $module ( @
{$state->{arguments
}} )
597 $log->debug("SEND : Module-expansion $module");
598 print "Module-expansion $module\n";
606 # Response expected: yes. Get files from the repository. This uses any
607 # previous Argument, Directory, Entry, or Modified requests, if they have
608 # been sent. Arguments to this command are module names; the client cannot
609 # know what directories they correspond to except by (1) just sending the
610 # co request, and then seeing what directory names the server sends back in
611 # its responses, and (2) the expand-modules request.
614 my ( $cmd, $data ) = @_;
618 my $module = $state->{args
}[0];
619 my $checkout_path = $module;
621 # use the user specified directory if we're given it
622 $checkout_path = $state->{opt
}{d
} if ( exists ( $state->{opt
}{d
} ) );
624 $log->debug("req_co : " . ( defined($data) ?
$data : "[NULL]" ) );
626 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
628 $ENV{GIT_DIR
} = $state->{CVSROOT
} . "/";
630 # Grab a handle to the SQLite db and do any necessary updates
631 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $module, $log);
634 $checkout_path =~ s
|/$||; # get rid of trailing slashes
636 # Eclipse seems to need the Clear-sticky command
637 # to prepare the 'Entries' file for the new directory.
638 print "Clear-sticky $checkout_path/\n";
639 print $state->{CVSROOT
} . "/$module/\n";
640 print "Clear-static-directory $checkout_path/\n";
641 print $state->{CVSROOT
} . "/$module/\n";
642 print "Clear-sticky $checkout_path/\n"; # yes, twice
643 print $state->{CVSROOT
} . "/$module/\n";
644 print "Template $checkout_path/\n";
645 print $state->{CVSROOT
} . "/$module/\n";
648 # instruct the client that we're checking out to $checkout_path
649 print "E cvs checkout: Updating $checkout_path\n";
656 my ($dir, $repodir, $remotedir, $seendirs) = @_;
657 my $parent = dirname
($dir);
660 $remotedir =~ s
|/+$||;
662 $log->debug("announcedir $dir, $repodir, $remotedir" );
664 if ($parent eq '.' || $parent eq './') {
667 # recurse to announce unseen parents first
668 if (length($parent) && !exists($seendirs->{$parent})) {
669 prepdir
($parent, $repodir, $remotedir, $seendirs);
671 # Announce that we are going to modify at the parent level
673 print "E cvs checkout: Updating $remotedir/$parent\n";
675 print "E cvs checkout: Updating $remotedir\n";
677 print "Clear-sticky $remotedir/$parent/\n";
678 print "$repodir/$parent/\n";
680 print "Clear-static-directory $remotedir/$dir/\n";
681 print "$repodir/$dir/\n";
682 print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
683 print "$repodir/$parent/\n";
684 print "Template $remotedir/$dir/\n";
685 print "$repodir/$dir/\n";
688 $seendirs->{$dir} = 1;
691 foreach my $git ( @
{$updater->gethead} )
693 # Don't want to check out deleted files
694 next if ( $git->{filehash
} eq "deleted" );
696 ( $git->{name
}, $git->{dir
} ) = filenamesplit
($git->{name
});
698 if (length($git->{dir
}) && $git->{dir
} ne './'
699 && $git->{dir
} ne $lastdir ) {
700 unless (exists($seendirs{$git->{dir
}})) {
701 prepdir
($git->{dir
}, $state->{CVSROOT
} . "/$module/",
702 $checkout_path, \
%seendirs);
703 $lastdir = $git->{dir
};
704 $seendirs{$git->{dir
}} = 1;
706 print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
709 # modification time of this file
710 print "Mod-time $git->{modified}\n";
712 # print some information to the client
713 if ( defined ( $git->{dir
} ) and $git->{dir
} ne "./" )
715 print "M U $checkout_path/$git->{dir}$git->{name}\n";
717 print "M U $checkout_path/$git->{name}\n";
720 # instruct client we're sending a file to put in this path
721 print "Created $checkout_path/" . ( defined ( $git->{dir
} ) and $git->{dir
} ne "./" ?
$git->{dir
} . "/" : "" ) . "\n";
723 print $state->{CVSROOT
} . "/$module/" . ( defined ( $git->{dir
} ) and $git->{dir
} ne "./" ?
$git->{dir
} . "/" : "" ) . "$git->{name}\n";
725 # this is an "entries" line
726 print "/$git->{name}/1.$git->{revision}///\n";
728 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
731 transmitfile
($git->{filehash
});
740 # Response expected: yes. Actually do a cvs update command. This uses any
741 # previous Argument, Directory, Entry, or Modified requests, if they have
742 # been sent. The last Directory sent specifies the working directory at the
743 # time of the operation. The -I option is not used--files which the client
744 # can decide whether to ignore are not mentioned and the client sends the
745 # Questionable request for others.
748 my ( $cmd, $data ) = @_;
750 $log->debug("req_update : " . ( defined($data) ?
$data : "[NULL]" ));
755 # It may just be a client exploring the available heads/modules
756 # in that case, list them as top level directories and leave it
757 # at that. Eclipse uses this technique to offer you a list of
758 # projects (heads in this case) to checkout.
760 if ($state->{module
} eq '') {
761 print "E cvs update: Updating .\n";
762 opendir HEADS
, $state->{CVSROOT
} . '/refs/heads';
763 while (my $head = readdir(HEADS
)) {
764 if (-f
$state->{CVSROOT
} . '/refs/heads/' . $head) {
765 print "E cvs update: New directory `$head'\n";
774 # Grab a handle to the SQLite db and do any necessary updates
775 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
779 argsfromdir
($updater);
781 #$log->debug("update state : " . Dumper($state));
783 # foreach file specified on the commandline ...
784 foreach my $filename ( @
{$state->{args
}} )
786 $filename = filecleanup
($filename);
788 $log->debug("Processing file $filename");
790 # if we have a -C we should pretend we never saw modified stuff
791 if ( exists ( $state->{opt
}{C
} ) )
793 delete $state->{entries
}{$filename}{modified_hash
};
794 delete $state->{entries
}{$filename}{modified_filename
};
795 $state->{entries
}{$filename}{unchanged
} = 1;
799 if ( defined($state->{opt
}{r
}) and $state->{opt
}{r
} =~ /^1\.(\d+)/ )
801 $meta = $updater->getmeta($filename, $1);
803 $meta = $updater->getmeta($filename);
806 next unless ( $meta->{revision
} );
810 my $wrev = revparse
($filename);
812 # If the working copy is an old revision, lets get that version too for comparison.
813 if ( defined($wrev) and $wrev != $meta->{revision
} )
815 $oldmeta = $updater->getmeta($filename, $wrev);
818 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
820 # Files are up to date if the working copy and repo copy have the same revision,
821 # and the working copy is unmodified _and_ the user hasn't specified -C
822 next if ( defined ( $wrev )
823 and defined($meta->{revision
})
824 and $wrev == $meta->{revision
}
825 and $state->{entries
}{$filename}{unchanged
}
826 and not exists ( $state->{opt
}{C
} ) );
828 # If the working copy and repo copy have the same revision,
829 # but the working copy is modified, tell the client it's modified
830 if ( defined ( $wrev )
831 and defined($meta->{revision
})
832 and $wrev == $meta->{revision
}
833 and not exists ( $state->{opt
}{C
} ) )
835 $log->info("Tell the client the file is modified");
837 print "MT fname $filename\n";
838 print "MT newline\n";
842 if ( $meta->{filehash
} eq "deleted" )
844 my ( $filepart, $dirpart ) = filenamesplit
($filename,1);
846 $log->info("Removing '$filename' from working copy (no longer in the repo)");
848 print "E cvs update: `$filename' is no longer in the repository\n";
849 # Don't want to actually _DO_ the update if -n specified
850 unless ( $state->{globaloptions
}{-n
} ) {
851 print "Removed $dirpart\n";
855 elsif ( not defined ( $state->{entries
}{$filename}{modified_hash
} )
856 or $state->{entries
}{$filename}{modified_hash
} eq $oldmeta->{filehash
} )
858 $log->info("Updating '$filename'");
859 # normal update, just send the new revision (either U=Update, or A=Add, or R=Remove)
860 print "MT +updated\n";
862 print "MT fname $filename\n";
863 print "MT newline\n";
864 print "MT -updated\n";
866 my ( $filepart, $dirpart ) = filenamesplit
($filename,1);
868 # Don't want to actually _DO_ the update if -n specified
869 unless ( $state->{globaloptions
}{-n
} )
871 if ( defined ( $wrev ) )
873 # instruct client we're sending a file to put in this path as a replacement
874 print "Update-existing $dirpart\n";
875 $log->debug("Updating existing file 'Update-existing $dirpart'");
877 # instruct client we're sending a file to put in this path as a new file
878 print "Clear-static-directory $dirpart\n";
879 print $state->{CVSROOT
} . "/$state->{module}/$dirpart\n";
880 print "Clear-sticky $dirpart\n";
881 print $state->{CVSROOT
} . "/$state->{module}/$dirpart\n";
883 $log->debug("Creating new file 'Created $dirpart'");
884 print "Created $dirpart\n";
886 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
888 # this is an "entries" line
889 $log->debug("/$filepart/1.$meta->{revision}///");
890 print "/$filepart/1.$meta->{revision}///\n";
893 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
894 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
897 transmitfile
($meta->{filehash
});
900 $log->info("Updating '$filename'");
901 my ( $filepart, $dirpart ) = filenamesplit
($meta->{name
},1);
903 my $dir = tempdir
( DIR
=> $TEMP_DIR, CLEANUP
=> 1 ) . "/";
906 my $file_local = $filepart . ".mine";
907 system("ln","-s",$state->{entries
}{$filename}{modified_filename
}, $file_local);
908 my $file_old = $filepart . "." . $oldmeta->{revision
};
909 transmitfile
($oldmeta->{filehash
}, $file_old);
910 my $file_new = $filepart . "." . $meta->{revision
};
911 transmitfile
($meta->{filehash
}, $file_new);
913 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
914 $log->info("Merging $file_local, $file_old, $file_new");
916 $log->debug("Temporary directory for merge is $dir");
918 my $return = system("merge", $file_local, $file_old, $file_new);
923 $log->info("Merged successfully");
924 print "M M $filename\n";
925 $log->debug("Update-existing $dirpart");
927 # Don't want to actually _DO_ the update if -n specified
928 unless ( $state->{globaloptions
}{-n
} )
930 print "Update-existing $dirpart\n";
931 $log->debug($state->{CVSROOT
} . "/$state->{module}/$filename");
932 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
933 $log->debug("/$filepart/1.$meta->{revision}///");
934 print "/$filepart/1.$meta->{revision}///\n";
937 elsif ( $return == 1 )
939 $log->info("Merged with conflicts");
940 print "M C $filename\n";
942 # Don't want to actually _DO_ the update if -n specified
943 unless ( $state->{globaloptions
}{-n
} )
945 print "Update-existing $dirpart\n";
946 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
947 print "/$filepart/1.$meta->{revision}/+//\n";
952 $log->warn("Merge failed");
956 # Don't want to actually _DO_ the update if -n specified
957 unless ( $state->{globaloptions
}{-n
} )
960 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
961 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
963 # transmit file, format is single integer on a line by itself (file
964 # size) followed by the file contents
965 # TODO : we should copy files in blocks
966 my $data = `cat $file_local`;
967 $log->debug("File size : " . length($data));
968 print length($data) . "\n";
982 my ( $cmd, $data ) = @_;
986 #$log->debug("State : " . Dumper($state));
988 $log->info("req_ci : " . ( defined($data) ?
$data : "[NULL]" ));
990 if ( @ARGV && $ARGV[0] eq 'pserver')
992 print "error 1 pserver access cannot commit\n";
996 if ( -e
$state->{CVSROOT
} . "/index" )
998 $log->warn("file 'index' already exists in the git repository");
999 print "error 1 Index already exists in git repo\n";
1003 my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
1004 unless ( sysopen(LOCKFILE
,$lockfile,O_EXCL
|O_CREAT
|O_WRONLY
) )
1006 $log->warn("lockfile '$lockfile' already exists, please try again");
1007 print "error 1 Lock file '$lockfile' already exists, please try again\n";
1011 # Grab a handle to the SQLite db and do any necessary updates
1012 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1015 my $tmpdir = tempdir
( DIR
=> $TEMP_DIR );
1016 my ( undef, $file_index ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1017 $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
1019 $ENV{GIT_DIR
} = $state->{CVSROOT
} . "/";
1020 $ENV{GIT_INDEX_FILE
} = $file_index;
1024 # populate the temporary index based
1025 system("git-read-tree", $state->{module
});
1028 die "Error running git-read-tree $state->{module} $file_index $!";
1030 $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
1033 my @committedfiles = ();
1035 # foreach file specified on the commandline ...
1036 foreach my $filename ( @
{$state->{args
}} )
1038 my $committedfile = $filename;
1039 $filename = filecleanup
($filename);
1041 next unless ( exists $state->{entries
}{$filename}{modified_filename
} or not $state->{entries
}{$filename}{unchanged
} );
1043 my $meta = $updater->getmeta($filename);
1045 my $wrev = revparse
($filename);
1047 my ( $filepart, $dirpart ) = filenamesplit
($filename);
1049 # do a checkout of the file if it part of this tree
1051 system('git-checkout-index', '-f', '-u', $filename);
1053 die "Error running git-checkout-index -f -u $filename : $!";
1059 $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1060 $addflag = 1 unless ( -e
$filename );
1062 # Do up to date checking
1063 unless ( $addflag or $wrev == $meta->{revision
} or ( $rmflag and -$wrev == $meta->{revision
} ) )
1065 # fail everything if an up to date check fails
1066 print "error 1 Up to date check failed for $filename\n";
1073 push @committedfiles, $committedfile;
1074 $log->info("Committing $filename");
1076 system("mkdir","-p",$dirpart) unless ( -d
$dirpart );
1080 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1081 rename $state->{entries
}{$filename}{modified_filename
},$filename;
1083 # Calculate modes to remove
1085 foreach ( qw
(r w x
) ) { $invmode .= $_ unless ( $state->{entries
}{$filename}{modified_mode
} =~ /$_/ ); }
1087 $log->debug("chmod u+" . $state->{entries
}{$filename}{modified_mode
} . "-" . $invmode . " $filename");
1088 system("chmod","u+" . $state->{entries
}{$filename}{modified_mode
} . "-" . $invmode, $filename);
1093 $log->info("Removing file '$filename'");
1095 system("git-update-index", "--remove", $filename);
1099 $log->info("Adding file '$filename'");
1100 system("git-update-index", "--add", $filename);
1102 $log->info("Updating file '$filename'");
1103 system("git-update-index", $filename);
1107 unless ( scalar(@committedfiles) > 0 )
1109 print "E No files to commit\n";
1117 my $treehash = `git-write-tree`;
1118 my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
1122 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1124 # write our commit message out if we have one ...
1125 my ( $msg_fh, $msg_filename ) = tempfile
( DIR
=> $TEMP_DIR );
1126 print $msg_fh $state->{opt
}{m
};# if ( exists ( $state->{opt}{m} ) );
1127 print $msg_fh "\n\nvia git-CVS emulator\n";
1130 my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1131 $log->info("Commit hash : $commithash");
1133 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1135 $log->warn("Commit failed (Invalid commit hash)");
1136 print "error 1 Commit failed (unknown reason)\n";
1143 open FILE
, ">", "$ENV{GIT_DIR}refs/heads/$state->{module}";
1144 print FILE
$commithash;
1149 # foreach file specified on the commandline ...
1150 foreach my $filename ( @committedfiles )
1152 $filename = filecleanup
($filename);
1154 my $meta = $updater->getmeta($filename);
1156 my ( $filepart, $dirpart ) = filenamesplit
($filename, 1);
1158 $log->debug("Checked-in $dirpart : $filename");
1160 if ( $meta->{filehash
} eq "deleted" )
1162 print "Remove-entry $dirpart\n";
1163 print "$filename\n";
1165 print "Checked-in $dirpart\n";
1166 print "$filename\n";
1167 print "/$filepart/1.$meta->{revision}///\n";
1180 my ( $cmd, $data ) = @_;
1184 $log->info("req_status : " . ( defined($data) ?
$data : "[NULL]" ));
1185 #$log->debug("status state : " . Dumper($state));
1187 # Grab a handle to the SQLite db and do any necessary updates
1188 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1191 # if no files were specified, we need to work out what files we should be providing status on ...
1192 argsfromdir
($updater);
1194 # foreach file specified on the commandline ...
1195 foreach my $filename ( @
{$state->{args
}} )
1197 $filename = filecleanup
($filename);
1199 my $meta = $updater->getmeta($filename);
1200 my $oldmeta = $meta;
1202 my $wrev = revparse
($filename);
1204 # If the working copy is an old revision, lets get that version too for comparison.
1205 if ( defined($wrev) and $wrev != $meta->{revision
} )
1207 $oldmeta = $updater->getmeta($filename, $wrev);
1210 # TODO : All possible statuses aren't yet implemented
1212 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1213 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision
}) and $wrev == $meta->{revision
}
1215 ( ( $state->{entries
}{$filename}{unchanged
} and ( not defined ( $state->{entries
}{$filename}{conflict
} ) or $state->{entries
}{$filename}{conflict
} !~ /^\+=/ ) )
1216 or ( defined($state->{entries
}{$filename}{modified_hash
}) and $state->{entries
}{$filename}{modified_hash
} eq $meta->{filehash
} ) )
1219 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1220 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision
} ) and $meta->{revision
} > $wrev
1222 ( $state->{entries
}{$filename}{unchanged
}
1223 or ( defined($state->{entries
}{$filename}{modified_hash
}) and $state->{entries
}{$filename}{modified_hash
} eq $oldmeta->{filehash
} ) )
1226 # Need checkout if it exists in the repo but doesn't have a working copy
1227 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision
} ) );
1229 # Locally modified if working copy and repo copy have the same revision but there are local changes
1230 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision
}) and $wrev == $meta->{revision
} and $state->{entries
}{$filename}{modified_filename
} );
1232 # Needs Merge if working copy revision is less than repo copy and there are local changes
1233 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision
} ) and $meta->{revision
} > $wrev and $state->{entries
}{$filename}{modified_filename
} );
1235 $status ||= "Locally Added" if ( defined ( $state->{entries
}{$filename}{revision
} ) and not defined ( $meta->{revision
} ) );
1236 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision
} ) and -$wrev == $meta->{revision
} );
1237 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries
}{$filename}{conflict
} ) and $state->{entries
}{$filename}{conflict
} =~ /^\+=/ );
1238 $status ||= "File had conflicts on merge" if ( 0 );
1240 $status ||= "Unknown";
1242 print "M ===================================================================\n";
1243 print "M File: $filename\tStatus: $status\n";
1244 if ( defined($state->{entries
}{$filename}{revision
}) )
1246 print "M Working revision:\t" . $state->{entries
}{$filename}{revision
} . "\n";
1248 print "M Working revision:\tNo entry for $filename\n";
1250 if ( defined($meta->{revision
}) )
1252 print "M Repository revision:\t1." . $meta->{revision
} . "\t$state->{repository}/$filename,v\n";
1253 print "M Sticky Tag:\t\t(none)\n";
1254 print "M Sticky Date:\t\t(none)\n";
1255 print "M Sticky Options:\t\t(none)\n";
1257 print "M Repository revision:\tNo revision control file\n";
1267 my ( $cmd, $data ) = @_;
1271 $log->debug("req_diff : " . ( defined($data) ?
$data : "[NULL]" ));
1272 #$log->debug("status state : " . Dumper($state));
1274 my ($revision1, $revision2);
1275 if ( defined ( $state->{opt
}{r
} ) and ref $state->{opt
}{r
} eq "ARRAY" )
1277 $revision1 = $state->{opt
}{r
}[0];
1278 $revision2 = $state->{opt
}{r
}[1];
1280 $revision1 = $state->{opt
}{r
};
1283 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1284 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1286 $log->debug("Diffing revisions " . ( defined($revision1) ?
$revision1 : "[NULL]" ) . " and " . ( defined($revision2) ?
$revision2 : "[NULL]" ) );
1288 # Grab a handle to the SQLite db and do any necessary updates
1289 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1292 # if no files were specified, we need to work out what files we should be providing status on ...
1293 argsfromdir
($updater);
1295 # foreach file specified on the commandline ...
1296 foreach my $filename ( @
{$state->{args
}} )
1298 $filename = filecleanup
($filename);
1300 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1302 my $wrev = revparse
($filename);
1304 # We need _something_ to diff against
1305 next unless ( defined ( $wrev ) );
1307 # if we have a -r switch, use it
1308 if ( defined ( $revision1 ) )
1310 ( undef, $file1 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1311 $meta1 = $updater->getmeta($filename, $revision1);
1312 unless ( defined ( $meta1 ) and $meta1->{filehash
} ne "deleted" )
1314 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1317 transmitfile
($meta1->{filehash
}, $file1);
1319 # otherwise we just use the working copy revision
1322 ( undef, $file1 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1323 $meta1 = $updater->getmeta($filename, $wrev);
1324 transmitfile
($meta1->{filehash
}, $file1);
1327 # if we have a second -r switch, use it too
1328 if ( defined ( $revision2 ) )
1330 ( undef, $file2 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1331 $meta2 = $updater->getmeta($filename, $revision2);
1333 unless ( defined ( $meta2 ) and $meta2->{filehash
} ne "deleted" )
1335 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1339 transmitfile
($meta2->{filehash
}, $file2);
1341 # otherwise we just use the working copy
1344 $file2 = $state->{entries
}{$filename}{modified_filename
};
1347 # if we have been given -r, and we don't have a $file2 yet, lets get one
1348 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1350 ( undef, $file2 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1351 $meta2 = $updater->getmeta($filename, $wrev);
1352 transmitfile
($meta2->{filehash
}, $file2);
1355 # We need to have retrieved something useful
1356 next unless ( defined ( $meta1 ) );
1358 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1359 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision
}
1361 ( ( $state->{entries
}{$filename}{unchanged
} and ( not defined ( $state->{entries
}{$filename}{conflict
} ) or $state->{entries
}{$filename}{conflict
} !~ /^\+=/ ) )
1362 or ( defined($state->{entries
}{$filename}{modified_hash
}) and $state->{entries
}{$filename}{modified_hash
} eq $meta1->{filehash
} ) )
1365 # Apparently we only show diffs for locally modified files
1366 next unless ( defined($meta2) or defined ( $state->{entries
}{$filename}{modified_filename
} ) );
1368 print "M Index: $filename\n";
1369 print "M ===================================================================\n";
1370 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1371 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1372 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1374 foreach my $opt ( keys %{$state->{opt
}} )
1376 if ( ref $state->{opt
}{$opt} eq "ARRAY" )
1378 foreach my $value ( @
{$state->{opt
}{$opt}} )
1380 print "-$opt $value ";
1384 print "$state->{opt}{$opt} " if ( defined ( $state->{opt
}{$opt} ) );
1387 print "$filename\n";
1389 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision
} or "workingcopy" ));
1391 ( $fh, $filediff ) = tempfile
( DIR
=> $TEMP_DIR );
1393 if ( exists $state->{opt
}{u
} )
1395 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision
}) ?
"revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1397 system("diff $file1 $file2 > $filediff");
1412 my ( $cmd, $data ) = @_;
1416 $log->debug("req_log : " . ( defined($data) ?
$data : "[NULL]" ));
1417 #$log->debug("log state : " . Dumper($state));
1419 my ( $minrev, $maxrev );
1420 if ( defined ( $state->{opt
}{r
} ) and $state->{opt
}{r
} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1425 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1426 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1427 $minrev++ if ( defined($minrev) and $control eq "::" );
1430 # Grab a handle to the SQLite db and do any necessary updates
1431 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1434 # if no files were specified, we need to work out what files we should be providing status on ...
1435 argsfromdir
($updater);
1437 # foreach file specified on the commandline ...
1438 foreach my $filename ( @
{$state->{args
}} )
1440 $filename = filecleanup
($filename);
1442 my $headmeta = $updater->getmeta($filename);
1444 my $revisions = $updater->getlog($filename);
1445 my $totalrevisions = scalar(@
$revisions);
1447 if ( defined ( $minrev ) )
1449 $log->debug("Removing revisions less than $minrev");
1450 while ( scalar(@
$revisions) > 0 and $revisions->[-1]{revision
} < $minrev )
1455 if ( defined ( $maxrev ) )
1457 $log->debug("Removing revisions greater than $maxrev");
1458 while ( scalar(@
$revisions) > 0 and $revisions->[0]{revision
} > $maxrev )
1464 next unless ( scalar(@
$revisions) );
1467 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1468 print "M Working file: $filename\n";
1469 print "M head: 1.$headmeta->{revision}\n";
1470 print "M branch:\n";
1471 print "M locks: strict\n";
1472 print "M access list:\n";
1473 print "M symbolic names:\n";
1474 print "M keyword substitution: kv\n";
1475 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@
$revisions) . "\n";
1476 print "M description:\n";
1478 foreach my $revision ( @
$revisions )
1480 print "M ----------------------------\n";
1481 print "M revision 1.$revision->{revision}\n";
1482 # reformat the date for log output
1483 $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}) );
1484 $revision->{author
} =~ s/\s+.*//;
1485 $revision->{author
} =~ s/^(.{8}).*/$1/;
1486 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash
} eq "deleted" ?
"dead" : "Exp" ) . "; lines: +2 -3\n";
1487 my $commitmessage = $updater->commitmessage($revision->{commithash
});
1488 $commitmessage =~ s/^/M /mg;
1489 print $commitmessage . "\n";
1491 print "M =============================================================================\n";
1499 my ( $cmd, $data ) = @_;
1501 argsplit
("annotate");
1503 $log->info("req_annotate : " . ( defined($data) ?
$data : "[NULL]" ));
1504 #$log->debug("status state : " . Dumper($state));
1506 # Grab a handle to the SQLite db and do any necessary updates
1507 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1510 # if no files were specified, we need to work out what files we should be providing annotate on ...
1511 argsfromdir
($updater);
1513 # we'll need a temporary checkout dir
1514 my $tmpdir = tempdir
( DIR
=> $TEMP_DIR );
1515 my ( undef, $file_index ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1516 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1518 $ENV{GIT_DIR
} = $state->{CVSROOT
} . "/";
1519 $ENV{GIT_INDEX_FILE
} = $file_index;
1523 # foreach file specified on the commandline ...
1524 foreach my $filename ( @
{$state->{args
}} )
1526 $filename = filecleanup
($filename);
1528 my $meta = $updater->getmeta($filename);
1530 next unless ( $meta->{revision
} );
1532 # get all the commits that this file was in
1533 # in dense format -- aka skip dead revisions
1534 my $revisions = $updater->gethistorydense($filename);
1535 my $lastseenin = $revisions->[0][2];
1537 # populate the temporary index based on the latest commit were we saw
1538 # the file -- but do it cheaply without checking out any files
1539 # TODO: if we got a revision from the client, use that instead
1540 # to look up the commithash in sqlite (still good to default to
1541 # the current head as we do now)
1542 system("git-read-tree", $lastseenin);
1545 die "Error running git-read-tree $lastseenin $file_index $!";
1547 $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1549 # do a checkout of the file
1550 system('git-checkout-index', '-f', '-u', $filename);
1552 die "Error running git-checkout-index -f -u $filename : $!";
1555 $log->info("Annotate $filename");
1557 # Prepare a file with the commits from the linearized
1558 # history that annotate should know about. This prevents
1559 # git-jsannotate telling us about commits we are hiding
1562 open(ANNOTATEHINTS
, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1563 for (my $i=0; $i < @
$revisions; $i++)
1565 print ANNOTATEHINTS
$revisions->[$i][2];
1566 if ($i+1 < @
$revisions) { # have we got a parent?
1567 print ANNOTATEHINTS
' ' . $revisions->[$i+1][2];
1569 print ANNOTATEHINTS
"\n";
1572 print ANNOTATEHINTS
"\n";
1573 close ANNOTATEHINTS
;
1575 my $annotatecmd = 'git-annotate';
1576 open(ANNOTATE
, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1577 or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1579 print "E Annotations for $filename\n";
1580 print "E ***************\n";
1581 while ( <ANNOTATE
> )
1583 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1585 my $commithash = $1;
1587 unless ( defined ( $metadata->{$commithash} ) )
1589 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1590 $metadata->{$commithash}{author
} =~ s/\s+.*//;
1591 $metadata->{$commithash}{author
} =~ s/^(.{8}).*/$1/;
1592 $metadata->{$commithash}{modified
} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified
} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1594 printf("M 1.%-5d (%-8s %10s): %s\n",
1595 $metadata->{$commithash}{revision
},
1596 $metadata->{$commithash}{author
},
1597 $metadata->{$commithash}{modified
},
1601 $log->warn("Error in annotate output! LINE: $_");
1602 print "E Annotate error \n";
1609 # done; get out of the tempdir
1616 # This method takes the state->{arguments} array and produces two new arrays.
1617 # The first is $state->{args} which is everything before the '--' argument, and
1618 # the second is $state->{files} which is everything after it.
1621 return unless( defined($state->{arguments
}) and ref $state->{arguments
} eq "ARRAY" );
1625 $state->{args
} = [];
1626 $state->{files
} = [];
1629 if ( defined($type) )
1632 $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" );
1633 $opt = { v
=> 0, l
=> 0, R
=> 0 } if ( $type eq "status" );
1634 $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" );
1635 $opt = { l
=> 0, R
=> 0, k
=> 1, D
=> 1, D
=> 1, r
=> 2 } if ( $type eq "diff" );
1636 $opt = { c
=> 0, R
=> 0, l
=> 0, f
=> 0, F
=> 1, m
=> 1, r
=> 1 } if ( $type eq "ci" );
1637 $opt = { k
=> 1, m
=> 1 } if ( $type eq "add" );
1638 $opt = { f
=> 0, l
=> 0, R
=> 0 } if ( $type eq "remove" );
1639 $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" );
1642 while ( scalar ( @
{$state->{arguments
}} ) > 0 )
1644 my $arg = shift @
{$state->{arguments
}};
1646 next if ( $arg eq "--" );
1647 next unless ( $arg =~ /\S/ );
1649 # if the argument looks like a switch
1650 if ( $arg =~ /^-(\w)(.*)/ )
1652 # if it's a switch that takes an argument
1655 # If this switch has already been provided
1656 if ( $opt->{$1} > 1 and exists ( $state->{opt
}{$1} ) )
1658 $state->{opt
}{$1} = [ $state->{opt
}{$1} ];
1659 if ( length($2) > 0 )
1661 push @
{$state->{opt
}{$1}},$2;
1663 push @
{$state->{opt
}{$1}}, shift @
{$state->{arguments
}};
1666 # if there's extra data in the arg, use that as the argument for the switch
1667 if ( length($2) > 0 )
1669 $state->{opt
}{$1} = $2;
1671 $state->{opt
}{$1} = shift @
{$state->{arguments
}};
1675 $state->{opt
}{$1} = undef;
1680 push @
{$state->{args
}}, $arg;
1688 foreach my $value ( @
{$state->{arguments
}} )
1690 if ( $value eq "--" )
1695 push @
{$state->{args
}}, $value if ( $mode == 0 );
1696 push @
{$state->{files
}}, $value if ( $mode == 1 );
1701 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1704 my $updater = shift;
1706 $state->{args
} = [] if ( scalar(@
{$state->{args
}}) == 1 and $state->{args
}[0] eq "." );
1708 return if ( scalar ( @
{$state->{args
}} ) > 0 );
1710 $log->info("No args specified, populating file list automatically");
1712 $state->{args
} = [];
1714 foreach my $file ( @
{$updater->gethead} )
1716 next if ( $file->{filehash
} eq "deleted" and not defined ( $state->{entries
}{$file->{name
}} ) );
1717 next unless ( $file->{name
} =~ s/^$state->{directory}// );
1718 push @
{$state->{args
}}, $file->{name
};
1722 # This method cleans up the $state variable after a command that uses arguments has run
1725 $state->{files
} = [];
1726 $state->{args
} = [];
1727 $state->{arguments
} = [];
1728 $state->{entries
} = {};
1733 my $filename = shift;
1735 return undef unless ( defined ( $state->{entries
}{$filename}{revision
} ) );
1737 return $1 if ( $state->{entries
}{$filename}{revision
} =~ /^1\.(\d+)/ );
1738 return -$1 if ( $state->{entries
}{$filename}{revision
} =~ /^-1\.(\d+)/ );
1743 # This method takes a file hash and does a CVS "file transfer" which transmits the
1744 # size of the file, and then the file contents.
1745 # If a second argument $targetfile is given, the file is instead written out to
1746 # a file by the name of $targetfile
1749 my $filehash = shift;
1750 my $targetfile = shift;
1752 if ( defined ( $filehash ) and $filehash eq "deleted" )
1754 $log->warn("filehash is 'deleted'");
1758 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1760 my $type = `git-cat-file -t $filehash`;
1763 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1765 my $size = `git-cat-file -s $filehash`;
1768 $log->debug("transmitfile($filehash) size=$size, type=$type");
1770 if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1772 if ( defined ( $targetfile ) )
1774 open NEWFILE
, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1775 print NEWFILE
$_ while ( <$fh> );
1779 print while ( <$fh> );
1781 close $fh or die ("Couldn't close filehandle for transmitfile()");
1783 die("Couldn't execute git-cat-file");
1787 # This method takes a file name, and returns ( $dirpart, $filepart ) which
1788 # refers to the directory portion and the file portion of the filename
1792 my $filename = shift;
1793 my $fixforlocaldir = shift;
1795 my ( $filepart, $dirpart ) = ( $filename, "." );
1796 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1799 if ( $fixforlocaldir )
1801 $dirpart =~ s/^$state->{prependdir}//;
1804 return ( $filepart, $dirpart );
1809 my $filename = shift;
1811 return undef unless(defined($filename));
1812 if ( $filename =~ /^\// )
1814 print "E absolute filenames '$filename' not supported by server\n";
1818 $filename =~ s/^\.\///g
;
1819 $filename = $state->{directory
} . $filename;
1823 package GITCVS
::log;
1826 #### Copyright The Open University UK - 2006.
1828 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
1829 #### Martin Langhoff <martin@catalyst.net.nz>
1842 This module provides very crude logging with a similar interface to
1851 Creates a new log object, optionally you can specify a filename here to
1852 indicate the file to log to. If no log file is specified, you can specify one
1853 later with method setfile, or indicate you no longer want logging with method
1856 Until one of these methods is called, all log calls will buffer messages ready
1863 my $filename = shift;
1867 bless $self, $class;
1869 if ( defined ( $filename ) )
1871 open $self->{fh
}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1879 This methods takes a filename, and attempts to open that file as the log file.
1880 If successful, all buffered data is written out to the file, and any further
1881 logging is written directly to the file.
1887 my $filename = shift;
1889 if ( defined ( $filename ) )
1891 open $self->{fh
}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1894 return unless ( defined ( $self->{buffer
} ) and ref $self->{buffer
} eq "ARRAY" );
1896 while ( my $line = shift @
{$self->{buffer
}} )
1898 print {$self->{fh
}} $line;
1904 This method indicates no logging is going to be used. It flushes any entries in
1905 the internal buffer, and sets a flag to ensure no further data is put there.
1914 return unless ( defined ( $self->{buffer
} ) and ref $self->{buffer
} eq "ARRAY" );
1916 $self->{buffer
} = [];
1921 Internal method. Returns true if the log file is open, false otherwise.
1928 return 1 if ( defined ( $self->{fh
} ) and ref $self->{fh
} eq "GLOB" );
1932 =head2 debug info warn fatal
1934 These four methods are wrappers to _log. They provide the actual interface for
1938 sub debug
{ my $self = shift; $self->_log("debug", @_); }
1939 sub info
{ my $self = shift; $self->_log("info" , @_); }
1940 sub warn { my $self = shift; $self->_log("warn" , @_); }
1941 sub fatal
{ my $self = shift; $self->_log("fatal", @_); }
1945 This is an internal method called by the logging functions. It generates a
1946 timestamp and pushes the logged line either to file, or internal buffer.
1954 return if ( $self->{nolog
} );
1956 my @time = localtime;
1957 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
1967 if ( $self->_logopen )
1969 print {$self->{fh
}} $timestring . " - " . join(" ",@_) . "\n";
1971 push @
{$self->{buffer
}}, $timestring . " - " . join(" ",@_) . "\n";
1977 This method simply closes the file handle if one is open
1984 if ( $self->_logopen )
1990 package GITCVS
::updater
;
1993 #### Copyright The Open University UK - 2006.
1995 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
1996 #### Martin Langhoff <martin@catalyst.net.nz>
2018 die "Need to specify a git repository" unless ( defined($config) and -d
$config );
2019 die "Need to specify a module" unless ( defined($module) );
2021 $class = ref($class) || $class;
2025 bless $self, $class;
2027 $self->{dbdir
} = $config . "/";
2028 die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir
}) and -d
$self->{dbdir
} );
2030 $self->{module
} = $module;
2031 $self->{file
} = $self->{dbdir
} . "/gitcvs.$module.sqlite";
2033 $self->{git_path
} = $config . "/";
2035 $self->{log} = $log;
2037 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d
$self->{git_path
} );
2039 $self->{dbh
} = DBI
->connect("dbi:SQLite:dbname=" . $self->{file
},"","");
2041 $self->{tables
} = {};
2042 foreach my $table ( $self->{dbh
}->tables )
2046 $self->{tables
}{$table} = 1;
2049 # Construct the revision table if required
2050 unless ( $self->{tables
}{revision
} )
2053 CREATE TABLE revision (
2055 revision INTEGER NOT NULL,
2056 filehash TEXT NOT NULL,
2057 commithash TEXT NOT NULL,
2058 author TEXT NOT NULL,
2059 modified TEXT NOT NULL,
2065 # Construct the revision table if required
2066 unless ( $self->{tables
}{head
} )
2071 revision INTEGER NOT NULL,
2072 filehash TEXT NOT NULL,
2073 commithash TEXT NOT NULL,
2074 author TEXT NOT NULL,
2075 modified TEXT NOT NULL,
2081 # Construct the properties table if required
2082 unless ( $self->{tables
}{properties
} )
2085 CREATE TABLE properties (
2086 key TEXT NOT NULL PRIMARY KEY,
2092 # Construct the commitmsgs table if required
2093 unless ( $self->{tables
}{commitmsgs
} )
2096 CREATE TABLE commitmsgs (
2097 key TEXT NOT NULL PRIMARY KEY,
2113 # first lets get the commit list
2114 $ENV{GIT_DIR
} = $self->{git_path
};
2116 # prepare database queries
2117 my $db_insert_rev = $self->{dbh
}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2118 my $db_insert_mergelog = $self->{dbh
}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2119 my $db_delete_head = $self->{dbh
}->prepare_cached("DELETE FROM head",{},1);
2120 my $db_insert_head = $self->{dbh
}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2122 my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2123 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2125 die("Invalid module '$self->{module}'");
2130 my $lastcommit = $self->_get_prop("last_commit");
2132 # Start exclusive lock here...
2133 $self->{dbh
}->begin_work() or die "Cannot lock database for BEGIN";
2135 # TODO: log processing is memory bound
2136 # if we can parse into a 2nd file that is in reverse order
2137 # we can probably do something really efficient
2138 my @git_log_params = ('--pretty', '--parents', '--topo-order');
2140 if (defined $lastcommit) {
2141 push @git_log_params, "$lastcommit..$self->{module}";
2143 push @git_log_params, $self->{module
};
2145 # git-rev-list is the backend / plumbing version of git-log
2146 open(GITLOG
, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2155 if (m/^commit\s+(.*)$/) {
2156 # on ^commit lines put the just seen commit in the stack
2157 # and prime things for the next one
2160 unshift @commits, \
%copy;
2163 my @parents = split(m/\s+/, $1);
2164 $commit{hash
} = shift @parents;
2165 $commit{parents
} = \
@parents;
2166 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message
})) {
2167 # on rfc822-like lines seen before we see any message,
2168 # lowercase the entry and put it in the hash as key-value
2169 $commit{lc($1)} = $2;
2171 # message lines - skip initial empty line
2172 # and trim whitespace
2173 if (!exists($commit{message
}) && m/^\s*$/) {
2174 # define it to mark the end of headers
2175 $commit{message
} = '';
2178 s/^\s+//; s/\s+$//; # trim ws
2179 $commit{message
} .= $_ . "\n";
2184 unshift @commits, \
%commit if ( keys %commit );
2186 # Now all the commits are in the @commits bucket
2187 # ordered by time DESC. for each commit that needs processing,
2188 # determine whether it's following the last head we've seen or if
2189 # it's on its own branch, grab a file list, and add whatever's changed
2190 # NOTE: $lastcommit refers to the last commit from previous run
2191 # $lastpicked is the last commit we picked in this run
2194 if (defined $lastcommit) {
2195 $lastpicked = $lastcommit;
2198 my $committotal = scalar(@commits);
2199 my $commitcount = 0;
2201 # Load the head table into $head (for cached lookups during the update process)
2202 foreach my $file ( @
{$self->gethead()} )
2204 $head->{$file->{name
}} = $file;
2207 foreach my $commit ( @commits )
2209 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2210 if (defined $lastpicked)
2212 if (!in_array
($lastpicked, @
{$commit->{parents
}}))
2214 # skip, we'll see this delta
2215 # as part of a merge later
2216 # warn "skipping off-track $commit->{hash}\n";
2218 } elsif (@
{$commit->{parents
}} > 1) {
2219 # it is a merge commit, for each parent that is
2220 # not $lastpicked, see if we can get a log
2221 # from the merge-base to that parent to put it
2222 # in the message as a merge summary.
2223 my @parents = @
{$commit->{parents
}};
2224 foreach my $parent (@parents) {
2225 # git-merge-base can potentially (but rarely) throw
2226 # several candidate merge bases. let's assume
2227 # that the first one is the best one.
2228 if ($parent eq $lastpicked) {
2231 open my $p, 'git-merge-base '. $lastpicked . ' '
2233 my @output = (<$p>);
2235 my $base = join('', @output);
2239 # print "want to log between $base $parent \n";
2240 open(GITLOG
, '-|', 'git-log', "$base..$parent")
2241 or die "Cannot call git-log: $!";
2245 if (!defined $mergedhash) {
2246 if (m/^commit\s+(.+)$/) {
2252 # grab the first line that looks non-rfc822
2253 # aka has content after leading space
2254 if (m/^\s+(\S.*)$/) {
2256 $title = substr($title,0,100); # truncate
2257 unshift @merged, "$mergedhash $title";
2264 $commit->{mergemsg
} = $commit->{message
};
2265 $commit->{mergemsg
} .= "\nSummary of merged commits:\n\n";
2266 foreach my $summary (@merged) {
2267 $commit->{mergemsg
} .= "\t$summary\n";
2269 $commit->{mergemsg
} .= "\n\n";
2270 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2277 # convert the date to CVS-happy format
2278 $commit->{date
} = "$2 $1 $4 $3 $5" if ( $commit->{date
} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2280 if ( defined ( $lastpicked ) )
2282 my $filepipe = open(FILELIST
, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash
}) or die("Cannot call git-diff-tree : $!");
2283 while ( <FILELIST
> )
2285 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 )
2287 die("Couldn't process git-diff-tree line : $_");
2290 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2293 $git_perms .= "r" if ( $1 & 4 );
2294 $git_perms .= "w" if ( $1 & 2 );
2295 $git_perms .= "x" if ( $1 & 1 );
2296 $git_perms = "rw" if ( $git_perms eq "" );
2300 #$log->debug("DELETE $4");
2303 revision
=> $head->{$4}{revision
} + 1,
2304 filehash
=> "deleted",
2305 commithash
=> $commit->{hash
},
2306 modified
=> $commit->{date
},
2307 author
=> $commit->{author
},
2310 $db_insert_rev->execute($4, $head->{$4}{revision
}, $2, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2314 #$log->debug("MODIFIED $4");
2317 revision
=> $head->{$4}{revision
} + 1,
2319 commithash
=> $commit->{hash
},
2320 modified
=> $commit->{date
},
2321 author
=> $commit->{author
},
2324 $db_insert_rev->execute($4, $head->{$4}{revision
}, $2, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2328 #$log->debug("ADDED $4");
2333 commithash
=> $commit->{hash
},
2334 modified
=> $commit->{date
},
2335 author
=> $commit->{author
},
2338 $db_insert_rev->execute($4, $head->{$4}{revision
}, $2, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2342 $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2348 # this is used to detect files removed from the repo
2349 my $seen_files = {};
2351 my $filepipe = open(FILELIST
, '-|', 'git-ls-tree', '-r', $commit->{hash
}) or die("Cannot call git-ls-tree : $!");
2352 while ( <FILELIST
> )
2354 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2356 die("Couldn't process git-ls-tree line : $_");
2359 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2361 $seen_files->{$git_filename} = 1;
2363 my ( $oldhash, $oldrevision, $oldmode ) = (
2364 $head->{$git_filename}{filehash
},
2365 $head->{$git_filename}{revision
},
2366 $head->{$git_filename}{mode
}
2369 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2372 $git_perms .= "r" if ( $1 & 4 );
2373 $git_perms .= "w" if ( $1 & 2 );
2374 $git_perms .= "x" if ( $1 & 1 );
2379 # unless the file exists with the same hash, we need to update it ...
2380 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2382 my $newrevision = ( $oldrevision or 0 ) + 1;
2384 $head->{$git_filename} = {
2385 name
=> $git_filename,
2386 revision
=> $newrevision,
2387 filehash
=> $git_hash,
2388 commithash
=> $commit->{hash
},
2389 modified
=> $commit->{date
},
2390 author
=> $commit->{author
},
2395 $db_insert_rev->execute($git_filename, $newrevision, $git_hash, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2400 # Detect deleted files
2401 foreach my $file ( keys %$head )
2403 unless ( exists $seen_files->{$file} or $head->{$file}{filehash
} eq "deleted" )
2405 $head->{$file}{revision
}++;
2406 $head->{$file}{filehash
} = "deleted";
2407 $head->{$file}{commithash
} = $commit->{hash
};
2408 $head->{$file}{modified
} = $commit->{date
};
2409 $head->{$file}{author
} = $commit->{author
};
2411 $db_insert_rev->execute($file, $head->{$file}{revision
}, $head->{$file}{filehash
}, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $head->{$file}{mode
});
2414 # END : "Detect deleted files"
2418 if (exists $commit->{mergemsg
})
2420 $db_insert_mergelog->execute($commit->{hash
}, $commit->{mergemsg
});
2423 $lastpicked = $commit->{hash
};
2425 $self->_set_prop("last_commit", $commit->{hash
});
2428 $db_delete_head->execute();
2429 foreach my $file ( keys %$head )
2431 $db_insert_head->execute(
2433 $head->{$file}{revision
},
2434 $head->{$file}{filehash
},
2435 $head->{$file}{commithash
},
2436 $head->{$file}{modified
},
2437 $head->{$file}{author
},
2438 $head->{$file}{mode
},
2441 # invalidate the gethead cache
2442 $self->{gethead_cache
} = undef;
2445 # Ending exclusive lock here
2446 $self->{dbh
}->commit() or die "Failed to commit changes to SQLite";
2452 my $filename = shift;
2454 my $db_query = $self->{dbh
}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2455 $db_query->execute($filename);
2456 my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2458 return ( $hash, $revision, $mode );
2466 my $db_query = $self->{dbh
}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2467 $db_query->execute($key);
2468 my ( $value ) = $db_query->fetchrow_array;
2479 my $db_query = $self->{dbh
}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2480 $db_query->execute($value, $key);
2482 unless ( $db_query->rows )
2484 $db_query = $self->{dbh
}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2485 $db_query->execute($key, $value);
2499 return $self->{gethead_cache
} if ( defined ( $self->{gethead_cache
} ) );
2501 my $db_query = $self->{dbh
}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2502 $db_query->execute();
2505 while ( my $file = $db_query->fetchrow_hashref )
2510 $self->{gethead_cache
} = $tree;
2522 my $filename = shift;
2524 my $db_query = $self->{dbh
}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2525 $db_query->execute($filename);
2528 while ( my $file = $db_query->fetchrow_hashref )
2538 This function takes a filename (with path) argument and returns a hashref of
2539 metadata for that file.
2546 my $filename = shift;
2547 my $revision = shift;
2550 if ( defined($revision) and $revision =~ /^\d+$/ )
2552 $db_query = $self->{dbh
}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2553 $db_query->execute($filename, $revision);
2555 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2557 $db_query = $self->{dbh
}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2558 $db_query->execute($filename, $revision);
2560 $db_query = $self->{dbh
}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2561 $db_query->execute($filename);
2564 return $db_query->fetchrow_hashref;
2567 =head2 commitmessage
2569 this function takes a commithash and returns the commit message for that commit
2575 my $commithash = shift;
2577 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2580 $db_query = $self->{dbh
}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2581 $db_query->execute($commithash);
2583 my ( $message ) = $db_query->fetchrow_array;
2585 if ( defined ( $message ) )
2587 $message .= " " if ( $message =~ /\n$/ );
2591 my @lines = safe_pipe_capture
("git-cat-file", "commit", $commithash);
2592 shift @lines while ( $lines[0] =~ /\S/ );
2593 $message = join("",@lines);
2594 $message .= " " if ( $message =~ /\n$/ );
2600 This function takes a filename (with path) argument and returns an arrayofarrays
2601 containing revision,filehash,commithash ordered by revision descending
2607 my $filename = shift;
2610 $db_query = $self->{dbh
}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2611 $db_query->execute($filename);
2613 return $db_query->fetchall_arrayref;
2616 =head2 gethistorydense
2618 This function takes a filename (with path) argument and returns an arrayofarrays
2619 containing revision,filehash,commithash ordered by revision descending.
2621 This version of gethistory skips deleted entries -- so it is useful for annotate.
2622 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2623 and other git tools that depend on it.
2629 my $filename = shift;
2632 $db_query = $self->{dbh
}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2633 $db_query->execute($filename);
2635 return $db_query->fetchall_arrayref;
2640 from Array::PAT - mimics the in_array() function
2641 found in PHP. Yuck but works for small arrays.
2646 my ($check, @array) = @_;
2648 foreach my $test (@array){
2649 if($check eq $test){
2656 =head2 safe_pipe_capture
2658 an alternative to `command` that allows input to be passed as an array
2659 to work around shell problems with weird characters in arguments
2662 sub safe_pipe_capture
{
2666 if (my $pid = open my $child, '-|') {
2667 @output = (<$child>);
2668 close $child or die join(' ',@_).": $! $?";
2670 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2672 return wantarray ?
@output : join('',@output);