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