path-list: fix path-list-insert return value
[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
d988b822 278 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
7d90095a
MS
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
0a7a9a12
JS
808 if ( ! defined $meta )
809 {
810 $meta = {
811 name => $filename,
812 revision => 0,
813 filehash => 'added'
814 };
815 }
3fda8c4c
ML
816
817 my $oldmeta = $meta;
818
819 my $wrev = revparse($filename);
820
821 # If the working copy is an old revision, lets get that version too for comparison.
822 if ( defined($wrev) and $wrev != $meta->{revision} )
823 {
824 $oldmeta = $updater->getmeta($filename, $wrev);
825 }
826
827 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
828
ec58db15
ML
829 # Files are up to date if the working copy and repo copy have the same revision,
830 # and the working copy is unmodified _and_ the user hasn't specified -C
831 next if ( defined ( $wrev )
832 and defined($meta->{revision})
833 and $wrev == $meta->{revision}
834 and $state->{entries}{$filename}{unchanged}
835 and not exists ( $state->{opt}{C} ) );
836
837 # If the working copy and repo copy have the same revision,
838 # but the working copy is modified, tell the client it's modified
839 if ( defined ( $wrev )
840 and defined($meta->{revision})
841 and $wrev == $meta->{revision}
842 and not exists ( $state->{opt}{C} ) )
843 {
844 $log->info("Tell the client the file is modified");
0a7a9a12 845 print "MT text M \n";
ec58db15
ML
846 print "MT fname $filename\n";
847 print "MT newline\n";
848 next;
849 }
3fda8c4c
ML
850
851 if ( $meta->{filehash} eq "deleted" )
852 {
7d90095a 853 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
3fda8c4c
ML
854
855 $log->info("Removing '$filename' from working copy (no longer in the repo)");
856
857 print "E cvs update: `$filename' is no longer in the repository\n";
7d90095a
MS
858 # Don't want to actually _DO_ the update if -n specified
859 unless ( $state->{globaloptions}{-n} ) {
860 print "Removed $dirpart\n";
861 print "$filepart\n";
862 }
3fda8c4c 863 }
ec58db15 864 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
0a7a9a12
JS
865 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
866 or $meta->{filehash} eq 'added' )
3fda8c4c 867 {
0a7a9a12
JS
868 # normal update, just send the new revision (either U=Update,
869 # or A=Add, or R=Remove)
870 if ( defined($wrev) && $wrev < 0 )
871 {
872 $log->info("Tell the client the file is scheduled for removal");
873 print "MT text R \n";
874 print "MT fname $filename\n";
875 print "MT newline\n";
876 next;
877 }
878 elsif ( !defined($wrev) || $wrev == 0 )
879 {
880 $log->info("Tell the client the file will be added");
881 print "MT text A \n";
882 print "MT fname $filename\n";
883 print "MT newline\n";
884 next;
885
886 }
887 else {
888 $log->info("Updating '$filename' $wrev");
889 print "MT +updated\n";
890 print "MT text U \n";
891 print "MT fname $filename\n";
892 print "MT newline\n";
893 print "MT -updated\n";
894 }
3fda8c4c 895
7d90095a
MS
896 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
897
898 # Don't want to actually _DO_ the update if -n specified
899 unless ( $state->{globaloptions}{-n} )
900 {
901 if ( defined ( $wrev ) )
902 {
903 # instruct client we're sending a file to put in this path as a replacement
904 print "Update-existing $dirpart\n";
905 $log->debug("Updating existing file 'Update-existing $dirpart'");
906 } else {
907 # instruct client we're sending a file to put in this path as a new file
908 print "Clear-static-directory $dirpart\n";
909 print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
910 print "Clear-sticky $dirpart\n";
911 print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
912
913 $log->debug("Creating new file 'Created $dirpart'");
914 print "Created $dirpart\n";
915 }
916 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
917
918 # this is an "entries" line
919 $log->debug("/$filepart/1.$meta->{revision}///");
920 print "/$filepart/1.$meta->{revision}///\n";
921
922 # permissions
923 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
924 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
925
926 # transmit file
927 transmitfile($meta->{filehash});
928 }
3fda8c4c 929 } else {
ec58db15 930 $log->info("Updating '$filename'");
7d90095a 931 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
3fda8c4c
ML
932
933 my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
934
935 chdir $dir;
936 my $file_local = $filepart . ".mine";
937 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
938 my $file_old = $filepart . "." . $oldmeta->{revision};
939 transmitfile($oldmeta->{filehash}, $file_old);
940 my $file_new = $filepart . "." . $meta->{revision};
941 transmitfile($meta->{filehash}, $file_new);
942
943 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
944 $log->info("Merging $file_local, $file_old, $file_new");
945
946 $log->debug("Temporary directory for merge is $dir");
947
948 my $return = system("merge", $file_local, $file_old, $file_new);
949 $return >>= 8;
950
951 if ( $return == 0 )
952 {
953 $log->info("Merged successfully");
954 print "M M $filename\n";
955 $log->debug("Update-existing $dirpart");
7d90095a
MS
956
957 # Don't want to actually _DO_ the update if -n specified
958 unless ( $state->{globaloptions}{-n} )
959 {
960 print "Update-existing $dirpart\n";
961 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
962 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
963 $log->debug("/$filepart/1.$meta->{revision}///");
964 print "/$filepart/1.$meta->{revision}///\n";
965 }
3fda8c4c
ML
966 }
967 elsif ( $return == 1 )
968 {
969 $log->info("Merged with conflicts");
970 print "M C $filename\n";
7d90095a
MS
971
972 # Don't want to actually _DO_ the update if -n specified
973 unless ( $state->{globaloptions}{-n} )
974 {
975 print "Update-existing $dirpart\n";
976 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
977 print "/$filepart/1.$meta->{revision}/+//\n";
978 }
3fda8c4c
ML
979 }
980 else
981 {
982 $log->warn("Merge failed");
983 next;
984 }
985
7d90095a
MS
986 # Don't want to actually _DO_ the update if -n specified
987 unless ( $state->{globaloptions}{-n} )
988 {
989 # permissions
990 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
991 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
992
993 # transmit file, format is single integer on a line by itself (file
994 # size) followed by the file contents
995 # TODO : we should copy files in blocks
996 my $data = `cat $file_local`;
997 $log->debug("File size : " . length($data));
998 print length($data) . "\n";
999 print $data;
1000 }
3fda8c4c
ML
1001
1002 chdir "/";
1003 }
1004
1005 }
1006
1007 print "ok\n";
1008}
1009
1010sub req_ci
1011{
1012 my ( $cmd, $data ) = @_;
1013
1014 argsplit("ci");
1015
1016 #$log->debug("State : " . Dumper($state));
1017
1018 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1019
91a6bf46
ML
1020 if ( @ARGV && $ARGV[0] eq 'pserver')
1021 {
1022 print "error 1 pserver access cannot commit\n";
1023 exit;
1024 }
1025
3fda8c4c
ML
1026 if ( -e $state->{CVSROOT} . "/index" )
1027 {
568907f5 1028 $log->warn("file 'index' already exists in the git repository");
3fda8c4c
ML
1029 print "error 1 Index already exists in git repo\n";
1030 exit;
1031 }
1032
1033 my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
1034 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )
1035 {
568907f5 1036 $log->warn("lockfile '$lockfile' already exists, please try again");
3fda8c4c
ML
1037 print "error 1 Lock file '$lockfile' already exists, please try again\n";
1038 exit;
1039 }
1040
1041 # Grab a handle to the SQLite db and do any necessary updates
1042 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1043 $updater->update();
1044
1045 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1046 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1047 $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
1048
1049 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1050 $ENV{GIT_INDEX_FILE} = $file_index;
1051
1052 chdir $tmpdir;
1053
1054 # populate the temporary index based
1055 system("git-read-tree", $state->{module});
1056 unless ($? == 0)
1057 {
1058 die "Error running git-read-tree $state->{module} $file_index $!";
1059 }
1060 $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
1061
1062
1063 my @committedfiles = ();
1064
addf88e4 1065 # foreach file specified on the command line ...
3fda8c4c
ML
1066 foreach my $filename ( @{$state->{args}} )
1067 {
7d90095a 1068 my $committedfile = $filename;
3fda8c4c
ML
1069 $filename = filecleanup($filename);
1070
1071 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1072
1073 my $meta = $updater->getmeta($filename);
1074
1075 my $wrev = revparse($filename);
1076
1077 my ( $filepart, $dirpart ) = filenamesplit($filename);
1078
1079 # do a checkout of the file if it part of this tree
1080 if ($wrev) {
1081 system('git-checkout-index', '-f', '-u', $filename);
1082 unless ($? == 0) {
1083 die "Error running git-checkout-index -f -u $filename : $!";
1084 }
1085 }
1086
1087 my $addflag = 0;
1088 my $rmflag = 0;
1089 $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1090 $addflag = 1 unless ( -e $filename );
1091
1092 # Do up to date checking
1093 unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1094 {
1095 # fail everything if an up to date check fails
1096 print "error 1 Up to date check failed for $filename\n";
1097 close LOCKFILE;
1098 unlink($lockfile);
1099 chdir "/";
1100 exit;
1101 }
1102
7d90095a 1103 push @committedfiles, $committedfile;
3fda8c4c
ML
1104 $log->info("Committing $filename");
1105
1106 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1107
1108 unless ( $rmflag )
1109 {
1110 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1111 rename $state->{entries}{$filename}{modified_filename},$filename;
1112
1113 # Calculate modes to remove
1114 my $invmode = "";
1115 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1116
1117 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1118 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1119 }
1120
1121 if ( $rmflag )
1122 {
1123 $log->info("Removing file '$filename'");
1124 unlink($filename);
1125 system("git-update-index", "--remove", $filename);
1126 }
1127 elsif ( $addflag )
1128 {
1129 $log->info("Adding file '$filename'");
1130 system("git-update-index", "--add", $filename);
1131 } else {
1132 $log->info("Updating file '$filename'");
1133 system("git-update-index", $filename);
1134 }
1135 }
1136
1137 unless ( scalar(@committedfiles) > 0 )
1138 {
1139 print "E No files to commit\n";
1140 print "ok\n";
1141 close LOCKFILE;
1142 unlink($lockfile);
1143 chdir "/";
1144 return;
1145 }
1146
1147 my $treehash = `git-write-tree`;
1148 my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
1149 chomp $treehash;
1150 chomp $parenthash;
1151
1152 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1153
1154 # write our commit message out if we have one ...
1155 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1156 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1157 print $msg_fh "\n\nvia git-CVS emulator\n";
1158 close $msg_fh;
1159
1160 my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1161 $log->info("Commit hash : $commithash");
1162
1163 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1164 {
1165 $log->warn("Commit failed (Invalid commit hash)");
1166 print "error 1 Commit failed (unknown reason)\n";
1167 close LOCKFILE;
1168 unlink($lockfile);
1169 chdir "/";
1170 exit;
1171 }
1172
cadbcf27 1173 print LOCKFILE $commithash;
3fda8c4c
ML
1174
1175 $updater->update();
1176
addf88e4 1177 # foreach file specified on the command line ...
3fda8c4c
ML
1178 foreach my $filename ( @committedfiles )
1179 {
1180 $filename = filecleanup($filename);
1181
1182 my $meta = $updater->getmeta($filename);
1183
7d90095a 1184 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
1185
1186 $log->debug("Checked-in $dirpart : $filename");
1187
1188 if ( $meta->{filehash} eq "deleted" )
1189 {
1190 print "Remove-entry $dirpart\n";
1191 print "$filename\n";
1192 } else {
1193 print "Checked-in $dirpart\n";
1194 print "$filename\n";
1195 print "/$filepart/1.$meta->{revision}///\n";
1196 }
1197 }
1198
1199 close LOCKFILE;
cadbcf27
JS
1200 my $reffile = "$ENV{GIT_DIR}refs/heads/$state->{module}";
1201 unlink($reffile);
1202 rename($lockfile, $reffile);
3fda8c4c
ML
1203 chdir "/";
1204
1205 print "ok\n";
1206}
1207
1208sub req_status
1209{
1210 my ( $cmd, $data ) = @_;
1211
1212 argsplit("status");
1213
1214 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1215 #$log->debug("status state : " . Dumper($state));
1216
1217 # Grab a handle to the SQLite db and do any necessary updates
1218 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1219 $updater->update();
1220
1221 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1222 argsfromdir($updater);
3fda8c4c 1223
addf88e4 1224 # foreach file specified on the command line ...
3fda8c4c
ML
1225 foreach my $filename ( @{$state->{args}} )
1226 {
1227 $filename = filecleanup($filename);
1228
1229 my $meta = $updater->getmeta($filename);
1230 my $oldmeta = $meta;
1231
1232 my $wrev = revparse($filename);
1233
1234 # If the working copy is an old revision, lets get that version too for comparison.
1235 if ( defined($wrev) and $wrev != $meta->{revision} )
1236 {
1237 $oldmeta = $updater->getmeta($filename, $wrev);
1238 }
1239
1240 # TODO : All possible statuses aren't yet implemented
1241 my $status;
1242 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1243 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1244 and
1245 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1246 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1247 );
1248
1249 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1250 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1251 and
1252 ( $state->{entries}{$filename}{unchanged}
1253 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1254 );
1255
1256 # Need checkout if it exists in the repo but doesn't have a working copy
1257 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1258
1259 # Locally modified if working copy and repo copy have the same revision but there are local changes
1260 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1261
1262 # Needs Merge if working copy revision is less than repo copy and there are local changes
1263 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1264
1265 $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1266 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1267 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1268 $status ||= "File had conflicts on merge" if ( 0 );
1269
1270 $status ||= "Unknown";
1271
1272 print "M ===================================================================\n";
1273 print "M File: $filename\tStatus: $status\n";
1274 if ( defined($state->{entries}{$filename}{revision}) )
1275 {
1276 print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1277 } else {
1278 print "M Working revision:\tNo entry for $filename\n";
1279 }
1280 if ( defined($meta->{revision}) )
1281 {
1282 print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1283 print "M Sticky Tag:\t\t(none)\n";
1284 print "M Sticky Date:\t\t(none)\n";
1285 print "M Sticky Options:\t\t(none)\n";
1286 } else {
1287 print "M Repository revision:\tNo revision control file\n";
1288 }
1289 print "M\n";
1290 }
1291
1292 print "ok\n";
1293}
1294
1295sub req_diff
1296{
1297 my ( $cmd, $data ) = @_;
1298
1299 argsplit("diff");
1300
1301 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1302 #$log->debug("status state : " . Dumper($state));
1303
1304 my ($revision1, $revision2);
1305 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1306 {
1307 $revision1 = $state->{opt}{r}[0];
1308 $revision2 = $state->{opt}{r}[1];
1309 } else {
1310 $revision1 = $state->{opt}{r};
1311 }
1312
1313 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1314 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1315
1316 $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1317
1318 # Grab a handle to the SQLite db and do any necessary updates
1319 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1320 $updater->update();
1321
1322 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1323 argsfromdir($updater);
3fda8c4c 1324
addf88e4 1325 # foreach file specified on the command line ...
3fda8c4c
ML
1326 foreach my $filename ( @{$state->{args}} )
1327 {
1328 $filename = filecleanup($filename);
1329
1330 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1331
1332 my $wrev = revparse($filename);
1333
1334 # We need _something_ to diff against
1335 next unless ( defined ( $wrev ) );
1336
1337 # if we have a -r switch, use it
1338 if ( defined ( $revision1 ) )
1339 {
1340 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1341 $meta1 = $updater->getmeta($filename, $revision1);
1342 unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1343 {
1344 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1345 next;
1346 }
1347 transmitfile($meta1->{filehash}, $file1);
1348 }
1349 # otherwise we just use the working copy revision
1350 else
1351 {
1352 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1353 $meta1 = $updater->getmeta($filename, $wrev);
1354 transmitfile($meta1->{filehash}, $file1);
1355 }
1356
1357 # if we have a second -r switch, use it too
1358 if ( defined ( $revision2 ) )
1359 {
1360 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1361 $meta2 = $updater->getmeta($filename, $revision2);
1362
1363 unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1364 {
1365 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1366 next;
1367 }
1368
1369 transmitfile($meta2->{filehash}, $file2);
1370 }
1371 # otherwise we just use the working copy
1372 else
1373 {
1374 $file2 = $state->{entries}{$filename}{modified_filename};
1375 }
1376
1377 # if we have been given -r, and we don't have a $file2 yet, lets get one
1378 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1379 {
1380 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1381 $meta2 = $updater->getmeta($filename, $wrev);
1382 transmitfile($meta2->{filehash}, $file2);
1383 }
1384
1385 # We need to have retrieved something useful
1386 next unless ( defined ( $meta1 ) );
1387
1388 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1389 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1390 and
1391 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1392 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1393 );
1394
1395 # Apparently we only show diffs for locally modified files
1396 next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1397
1398 print "M Index: $filename\n";
1399 print "M ===================================================================\n";
1400 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1401 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1402 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1403 print "M diff ";
1404 foreach my $opt ( keys %{$state->{opt}} )
1405 {
1406 if ( ref $state->{opt}{$opt} eq "ARRAY" )
1407 {
1408 foreach my $value ( @{$state->{opt}{$opt}} )
1409 {
1410 print "-$opt $value ";
1411 }
1412 } else {
1413 print "-$opt ";
1414 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1415 }
1416 }
1417 print "$filename\n";
1418
1419 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1420
1421 ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1422
1423 if ( exists $state->{opt}{u} )
1424 {
1425 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1426 } else {
1427 system("diff $file1 $file2 > $filediff");
1428 }
1429
1430 while ( <$fh> )
1431 {
1432 print "M $_";
1433 }
1434 close $fh;
1435 }
1436
1437 print "ok\n";
1438}
1439
1440sub req_log
1441{
1442 my ( $cmd, $data ) = @_;
1443
1444 argsplit("log");
1445
1446 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1447 #$log->debug("log state : " . Dumper($state));
1448
1449 my ( $minrev, $maxrev );
1450 if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1451 {
1452 my $control = $2;
1453 $minrev = $1;
1454 $maxrev = $3;
1455 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1456 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1457 $minrev++ if ( defined($minrev) and $control eq "::" );
1458 }
1459
1460 # Grab a handle to the SQLite db and do any necessary updates
1461 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1462 $updater->update();
1463
1464 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1465 argsfromdir($updater);
3fda8c4c 1466
addf88e4 1467 # foreach file specified on the command line ...
3fda8c4c
ML
1468 foreach my $filename ( @{$state->{args}} )
1469 {
1470 $filename = filecleanup($filename);
1471
1472 my $headmeta = $updater->getmeta($filename);
1473
1474 my $revisions = $updater->getlog($filename);
1475 my $totalrevisions = scalar(@$revisions);
1476
1477 if ( defined ( $minrev ) )
1478 {
1479 $log->debug("Removing revisions less than $minrev");
1480 while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1481 {
1482 pop @$revisions;
1483 }
1484 }
1485 if ( defined ( $maxrev ) )
1486 {
1487 $log->debug("Removing revisions greater than $maxrev");
1488 while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1489 {
1490 shift @$revisions;
1491 }
1492 }
1493
1494 next unless ( scalar(@$revisions) );
1495
1496 print "M \n";
1497 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1498 print "M Working file: $filename\n";
1499 print "M head: 1.$headmeta->{revision}\n";
1500 print "M branch:\n";
1501 print "M locks: strict\n";
1502 print "M access list:\n";
1503 print "M symbolic names:\n";
1504 print "M keyword substitution: kv\n";
1505 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1506 print "M description:\n";
1507
1508 foreach my $revision ( @$revisions )
1509 {
1510 print "M ----------------------------\n";
1511 print "M revision 1.$revision->{revision}\n";
1512 # reformat the date for log output
1513 $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}) );
1514 $revision->{author} =~ s/\s+.*//;
1515 $revision->{author} =~ s/^(.{8}).*/$1/;
1516 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . "; lines: +2 -3\n";
1517 my $commitmessage = $updater->commitmessage($revision->{commithash});
1518 $commitmessage =~ s/^/M /mg;
1519 print $commitmessage . "\n";
1520 }
1521 print "M =============================================================================\n";
1522 }
1523
1524 print "ok\n";
1525}
1526
1527sub req_annotate
1528{
1529 my ( $cmd, $data ) = @_;
1530
1531 argsplit("annotate");
1532
1533 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1534 #$log->debug("status state : " . Dumper($state));
1535
1536 # Grab a handle to the SQLite db and do any necessary updates
1537 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1538 $updater->update();
1539
1540 # if no files were specified, we need to work out what files we should be providing annotate on ...
7d90095a 1541 argsfromdir($updater);
3fda8c4c
ML
1542
1543 # we'll need a temporary checkout dir
1544 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1545 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1546 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1547
1548 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1549 $ENV{GIT_INDEX_FILE} = $file_index;
1550
1551 chdir $tmpdir;
1552
addf88e4 1553 # foreach file specified on the command line ...
3fda8c4c
ML
1554 foreach my $filename ( @{$state->{args}} )
1555 {
1556 $filename = filecleanup($filename);
1557
1558 my $meta = $updater->getmeta($filename);
1559
1560 next unless ( $meta->{revision} );
1561
1562 # get all the commits that this file was in
1563 # in dense format -- aka skip dead revisions
1564 my $revisions = $updater->gethistorydense($filename);
1565 my $lastseenin = $revisions->[0][2];
1566
1567 # populate the temporary index based on the latest commit were we saw
1568 # the file -- but do it cheaply without checking out any files
1569 # TODO: if we got a revision from the client, use that instead
1570 # to look up the commithash in sqlite (still good to default to
1571 # the current head as we do now)
1572 system("git-read-tree", $lastseenin);
1573 unless ($? == 0)
1574 {
1575 die "Error running git-read-tree $lastseenin $file_index $!";
1576 }
1577 $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1578
1579 # do a checkout of the file
1580 system('git-checkout-index', '-f', '-u', $filename);
1581 unless ($? == 0) {
1582 die "Error running git-checkout-index -f -u $filename : $!";
1583 }
1584
1585 $log->info("Annotate $filename");
1586
1587 # Prepare a file with the commits from the linearized
1588 # history that annotate should know about. This prevents
1589 # git-jsannotate telling us about commits we are hiding
1590 # from the client.
1591
1592 open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1593 for (my $i=0; $i < @$revisions; $i++)
1594 {
1595 print ANNOTATEHINTS $revisions->[$i][2];
1596 if ($i+1 < @$revisions) { # have we got a parent?
1597 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1598 }
1599 print ANNOTATEHINTS "\n";
1600 }
1601
1602 print ANNOTATEHINTS "\n";
1603 close ANNOTATEHINTS;
1604
1605 my $annotatecmd = 'git-annotate';
1606 open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1607 or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1608 my $metadata = {};
1609 print "E Annotations for $filename\n";
1610 print "E ***************\n";
1611 while ( <ANNOTATE> )
1612 {
1613 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1614 {
1615 my $commithash = $1;
1616 my $data = $2;
1617 unless ( defined ( $metadata->{$commithash} ) )
1618 {
1619 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1620 $metadata->{$commithash}{author} =~ s/\s+.*//;
1621 $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1622 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1623 }
1624 printf("M 1.%-5d (%-8s %10s): %s\n",
1625 $metadata->{$commithash}{revision},
1626 $metadata->{$commithash}{author},
1627 $metadata->{$commithash}{modified},
1628 $data
1629 );
1630 } else {
1631 $log->warn("Error in annotate output! LINE: $_");
1632 print "E Annotate error \n";
1633 next;
1634 }
1635 }
1636 close ANNOTATE;
1637 }
1638
1639 # done; get out of the tempdir
1640 chdir "/";
1641
1642 print "ok\n";
1643
1644}
1645
1646# This method takes the state->{arguments} array and produces two new arrays.
1647# The first is $state->{args} which is everything before the '--' argument, and
1648# the second is $state->{files} which is everything after it.
1649sub argsplit
1650{
1651 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1652
1653 my $type = shift;
1654
1655 $state->{args} = [];
1656 $state->{files} = [];
1657 $state->{opt} = {};
1658
1659 if ( defined($type) )
1660 {
1661 my $opt = {};
1662 $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" );
1663 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1664 $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" );
1665 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1666 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1667 $opt = { k => 1, m => 1 } if ( $type eq "add" );
1668 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1669 $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" );
1670
1671
1672 while ( scalar ( @{$state->{arguments}} ) > 0 )
1673 {
1674 my $arg = shift @{$state->{arguments}};
1675
1676 next if ( $arg eq "--" );
1677 next unless ( $arg =~ /\S/ );
1678
1679 # if the argument looks like a switch
1680 if ( $arg =~ /^-(\w)(.*)/ )
1681 {
1682 # if it's a switch that takes an argument
1683 if ( $opt->{$1} )
1684 {
1685 # If this switch has already been provided
1686 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1687 {
1688 $state->{opt}{$1} = [ $state->{opt}{$1} ];
1689 if ( length($2) > 0 )
1690 {
1691 push @{$state->{opt}{$1}},$2;
1692 } else {
1693 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1694 }
1695 } else {
1696 # if there's extra data in the arg, use that as the argument for the switch
1697 if ( length($2) > 0 )
1698 {
1699 $state->{opt}{$1} = $2;
1700 } else {
1701 $state->{opt}{$1} = shift @{$state->{arguments}};
1702 }
1703 }
1704 } else {
1705 $state->{opt}{$1} = undef;
1706 }
1707 }
1708 else
1709 {
1710 push @{$state->{args}}, $arg;
1711 }
1712 }
1713 }
1714 else
1715 {
1716 my $mode = 0;
1717
1718 foreach my $value ( @{$state->{arguments}} )
1719 {
1720 if ( $value eq "--" )
1721 {
1722 $mode++;
1723 next;
1724 }
1725 push @{$state->{args}}, $value if ( $mode == 0 );
1726 push @{$state->{files}}, $value if ( $mode == 1 );
1727 }
1728 }
1729}
1730
1731# This method uses $state->{directory} to populate $state->{args} with a list of filenames
1732sub argsfromdir
1733{
1734 my $updater = shift;
1735
7d90095a
MS
1736 $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
1737
82000d74 1738 return if ( scalar ( @{$state->{args}} ) > 1 );
7d90095a 1739
0a7a9a12
JS
1740 my @gethead = @{$updater->gethead};
1741
1742 # push added files
1743 foreach my $file (keys %{$state->{entries}}) {
1744 if ( exists $state->{entries}{$file}{revision} &&
1745 $state->{entries}{$file}{revision} == 0 )
1746 {
1747 push @gethead, { name => $file, filehash => 'added' };
1748 }
1749 }
1750
82000d74
MS
1751 if ( scalar(@{$state->{args}}) == 1 )
1752 {
1753 my $arg = $state->{args}[0];
1754 $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
7d90095a 1755
82000d74 1756 $log->info("Only one arg specified, checking for directory expansion on '$arg'");
3fda8c4c 1757
0a7a9a12 1758 foreach my $file ( @gethead )
82000d74
MS
1759 {
1760 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1761 next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg );
1762 push @{$state->{args}}, $file->{name};
1763 }
1764
1765 shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
1766 } else {
1767 $log->info("Only one arg specified, populating file list automatically");
1768
1769 $state->{args} = [];
1770
0a7a9a12 1771 foreach my $file ( @gethead )
82000d74
MS
1772 {
1773 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1774 next unless ( $file->{name} =~ s/^$state->{prependdir}// );
1775 push @{$state->{args}}, $file->{name};
1776 }
3fda8c4c
ML
1777 }
1778}
1779
1780# This method cleans up the $state variable after a command that uses arguments has run
1781sub statecleanup
1782{
1783 $state->{files} = [];
1784 $state->{args} = [];
1785 $state->{arguments} = [];
1786 $state->{entries} = {};
1787}
1788
1789sub revparse
1790{
1791 my $filename = shift;
1792
1793 return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1794
1795 return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1796 return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1797
1798 return undef;
1799}
1800
1801# This method takes a file hash and does a CVS "file transfer" which transmits the
1802# size of the file, and then the file contents.
1803# If a second argument $targetfile is given, the file is instead written out to
1804# a file by the name of $targetfile
1805sub transmitfile
1806{
1807 my $filehash = shift;
1808 my $targetfile = shift;
1809
1810 if ( defined ( $filehash ) and $filehash eq "deleted" )
1811 {
1812 $log->warn("filehash is 'deleted'");
1813 return;
1814 }
1815
1816 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1817
1818 my $type = `git-cat-file -t $filehash`;
1819 chomp $type;
1820
1821 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1822
1823 my $size = `git-cat-file -s $filehash`;
1824 chomp $size;
1825
1826 $log->debug("transmitfile($filehash) size=$size, type=$type");
1827
1828 if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1829 {
1830 if ( defined ( $targetfile ) )
1831 {
1832 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1833 print NEWFILE $_ while ( <$fh> );
1834 close NEWFILE;
1835 } else {
1836 print "$size\n";
1837 print while ( <$fh> );
1838 }
1839 close $fh or die ("Couldn't close filehandle for transmitfile()");
1840 } else {
1841 die("Couldn't execute git-cat-file");
1842 }
1843}
1844
1845# This method takes a file name, and returns ( $dirpart, $filepart ) which
5348b6e7 1846# refers to the directory portion and the file portion of the filename
3fda8c4c
ML
1847# respectively
1848sub filenamesplit
1849{
1850 my $filename = shift;
7d90095a 1851 my $fixforlocaldir = shift;
3fda8c4c
ML
1852
1853 my ( $filepart, $dirpart ) = ( $filename, "." );
1854 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1855 $dirpart .= "/";
1856
7d90095a
MS
1857 if ( $fixforlocaldir )
1858 {
1859 $dirpart =~ s/^$state->{prependdir}//;
1860 }
1861
3fda8c4c
ML
1862 return ( $filepart, $dirpart );
1863}
1864
1865sub filecleanup
1866{
1867 my $filename = shift;
1868
1869 return undef unless(defined($filename));
1870 if ( $filename =~ /^\// )
1871 {
1872 print "E absolute filenames '$filename' not supported by server\n";
1873 return undef;
1874 }
1875
1876 $filename =~ s/^\.\///g;
82000d74 1877 $filename = $state->{prependdir} . $filename;
3fda8c4c
ML
1878 return $filename;
1879}
1880
1881package GITCVS::log;
1882
1883####
1884#### Copyright The Open University UK - 2006.
1885####
1886#### Authors: Martyn Smith <martyn@catalyst.net.nz>
1887#### Martin Langhoff <martin@catalyst.net.nz>
1888####
1889####
1890
1891use strict;
1892use warnings;
1893
1894=head1 NAME
1895
1896GITCVS::log
1897
1898=head1 DESCRIPTION
1899
1900This module provides very crude logging with a similar interface to
1901Log::Log4perl
1902
1903=head1 METHODS
1904
1905=cut
1906
1907=head2 new
1908
1909Creates a new log object, optionally you can specify a filename here to
5348b6e7 1910indicate the file to log to. If no log file is specified, you can specify one
3fda8c4c
ML
1911later with method setfile, or indicate you no longer want logging with method
1912nofile.
1913
1914Until one of these methods is called, all log calls will buffer messages ready
1915to write out.
1916
1917=cut
1918sub new
1919{
1920 my $class = shift;
1921 my $filename = shift;
1922
1923 my $self = {};
1924
1925 bless $self, $class;
1926
1927 if ( defined ( $filename ) )
1928 {
1929 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1930 }
1931
1932 return $self;
1933}
1934
1935=head2 setfile
1936
1937This methods takes a filename, and attempts to open that file as the log file.
1938If successful, all buffered data is written out to the file, and any further
1939logging is written directly to the file.
1940
1941=cut
1942sub setfile
1943{
1944 my $self = shift;
1945 my $filename = shift;
1946
1947 if ( defined ( $filename ) )
1948 {
1949 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1950 }
1951
1952 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1953
1954 while ( my $line = shift @{$self->{buffer}} )
1955 {
1956 print {$self->{fh}} $line;
1957 }
1958}
1959
1960=head2 nofile
1961
1962This method indicates no logging is going to be used. It flushes any entries in
1963the internal buffer, and sets a flag to ensure no further data is put there.
1964
1965=cut
1966sub nofile
1967{
1968 my $self = shift;
1969
1970 $self->{nolog} = 1;
1971
1972 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1973
1974 $self->{buffer} = [];
1975}
1976
1977=head2 _logopen
1978
1979Internal method. Returns true if the log file is open, false otherwise.
1980
1981=cut
1982sub _logopen
1983{
1984 my $self = shift;
1985
1986 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
1987 return 0;
1988}
1989
1990=head2 debug info warn fatal
1991
1992These four methods are wrappers to _log. They provide the actual interface for
1993logging data.
1994
1995=cut
1996sub debug { my $self = shift; $self->_log("debug", @_); }
1997sub info { my $self = shift; $self->_log("info" , @_); }
1998sub warn { my $self = shift; $self->_log("warn" , @_); }
1999sub fatal { my $self = shift; $self->_log("fatal", @_); }
2000
2001=head2 _log
2002
2003This is an internal method called by the logging functions. It generates a
2004timestamp and pushes the logged line either to file, or internal buffer.
2005
2006=cut
2007sub _log
2008{
2009 my $self = shift;
2010 my $level = shift;
2011
2012 return if ( $self->{nolog} );
2013
2014 my @time = localtime;
2015 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2016 $time[5] + 1900,
2017 $time[4] + 1,
2018 $time[3],
2019 $time[2],
2020 $time[1],
2021 $time[0],
2022 uc $level,
2023 );
2024
2025 if ( $self->_logopen )
2026 {
2027 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
2028 } else {
2029 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
2030 }
2031}
2032
2033=head2 DESTROY
2034
2035This method simply closes the file handle if one is open
2036
2037=cut
2038sub DESTROY
2039{
2040 my $self = shift;
2041
2042 if ( $self->_logopen )
2043 {
2044 close $self->{fh};
2045 }
2046}
2047
2048package GITCVS::updater;
2049
2050####
2051#### Copyright The Open University UK - 2006.
2052####
2053#### Authors: Martyn Smith <martyn@catalyst.net.nz>
2054#### Martin Langhoff <martin@catalyst.net.nz>
2055####
2056####
2057
2058use strict;
2059use warnings;
2060use DBI;
2061
2062=head1 METHODS
2063
2064=cut
2065
2066=head2 new
2067
2068=cut
2069sub new
2070{
2071 my $class = shift;
2072 my $config = shift;
2073 my $module = shift;
2074 my $log = shift;
2075
2076 die "Need to specify a git repository" unless ( defined($config) and -d $config );
2077 die "Need to specify a module" unless ( defined($module) );
2078
2079 $class = ref($class) || $class;
2080
2081 my $self = {};
2082
2083 bless $self, $class;
2084
2085 $self->{dbdir} = $config . "/";
2086 die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
2087
2088 $self->{module} = $module;
2089 $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
2090
2091 $self->{git_path} = $config . "/";
2092
2093 $self->{log} = $log;
2094
2095 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2096
2097 $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
2098
2099 $self->{tables} = {};
2100 foreach my $table ( $self->{dbh}->tables )
2101 {
2102 $table =~ s/^"//;
2103 $table =~ s/"$//;
2104 $self->{tables}{$table} = 1;
2105 }
2106
2107 # Construct the revision table if required
2108 unless ( $self->{tables}{revision} )
2109 {
2110 $self->{dbh}->do("
2111 CREATE TABLE revision (
2112 name TEXT NOT NULL,
2113 revision INTEGER NOT NULL,
2114 filehash TEXT NOT NULL,
2115 commithash TEXT NOT NULL,
2116 author TEXT NOT NULL,
2117 modified TEXT NOT NULL,
2118 mode TEXT NOT NULL
2119 )
2120 ");
2121 }
2122
2123 # Construct the revision table if required
2124 unless ( $self->{tables}{head} )
2125 {
2126 $self->{dbh}->do("
2127 CREATE TABLE head (
2128 name TEXT NOT NULL,
2129 revision INTEGER NOT NULL,
2130 filehash TEXT NOT NULL,
2131 commithash TEXT NOT NULL,
2132 author TEXT NOT NULL,
2133 modified TEXT NOT NULL,
2134 mode TEXT NOT NULL
2135 )
2136 ");
2137 }
2138
2139 # Construct the properties table if required
2140 unless ( $self->{tables}{properties} )
2141 {
2142 $self->{dbh}->do("
2143 CREATE TABLE properties (
2144 key TEXT NOT NULL PRIMARY KEY,
2145 value TEXT
2146 )
2147 ");
2148 }
2149
2150 # Construct the commitmsgs table if required
2151 unless ( $self->{tables}{commitmsgs} )
2152 {
2153 $self->{dbh}->do("
2154 CREATE TABLE commitmsgs (
2155 key TEXT NOT NULL PRIMARY KEY,
2156 value TEXT
2157 )
2158 ");
2159 }
2160
2161 return $self;
2162}
2163
2164=head2 update
2165
2166=cut
2167sub update
2168{
2169 my $self = shift;
2170
2171 # first lets get the commit list
2172 $ENV{GIT_DIR} = $self->{git_path};
2173
3fda8c4c
ML
2174 my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2175 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2176 {
2177 die("Invalid module '$self->{module}'");
2178 }
2179
2180
2181 my $git_log;
2182 my $lastcommit = $self->_get_prop("last_commit");
2183
2184 # Start exclusive lock here...
2185 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2186
2187 # TODO: log processing is memory bound
2188 # if we can parse into a 2nd file that is in reverse order
2189 # we can probably do something really efficient
a248c961 2190 my @git_log_params = ('--pretty', '--parents', '--topo-order');
3fda8c4c
ML
2191
2192 if (defined $lastcommit) {
2193 push @git_log_params, "$lastcommit..$self->{module}";
2194 } else {
2195 push @git_log_params, $self->{module};
2196 }
a248c961
ML
2197 # git-rev-list is the backend / plumbing version of git-log
2198 open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
3fda8c4c
ML
2199
2200 my @commits;
2201
2202 my %commit = ();
2203
2204 while ( <GITLOG> )
2205 {
2206 chomp;
2207 if (m/^commit\s+(.*)$/) {
2208 # on ^commit lines put the just seen commit in the stack
2209 # and prime things for the next one
2210 if (keys %commit) {
2211 my %copy = %commit;
2212 unshift @commits, \%copy;
2213 %commit = ();
2214 }
2215 my @parents = split(m/\s+/, $1);
2216 $commit{hash} = shift @parents;
2217 $commit{parents} = \@parents;
2218 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2219 # on rfc822-like lines seen before we see any message,
2220 # lowercase the entry and put it in the hash as key-value
2221 $commit{lc($1)} = $2;
2222 } else {
2223 # message lines - skip initial empty line
2224 # and trim whitespace
2225 if (!exists($commit{message}) && m/^\s*$/) {
2226 # define it to mark the end of headers
2227 $commit{message} = '';
2228 next;
2229 }
2230 s/^\s+//; s/\s+$//; # trim ws
2231 $commit{message} .= $_ . "\n";
2232 }
2233 }
2234 close GITLOG;
2235
2236 unshift @commits, \%commit if ( keys %commit );
2237
2238 # Now all the commits are in the @commits bucket
2239 # ordered by time DESC. for each commit that needs processing,
2240 # determine whether it's following the last head we've seen or if
2241 # it's on its own branch, grab a file list, and add whatever's changed
2242 # NOTE: $lastcommit refers to the last commit from previous run
2243 # $lastpicked is the last commit we picked in this run
2244 my $lastpicked;
2245 my $head = {};
2246 if (defined $lastcommit) {
2247 $lastpicked = $lastcommit;
2248 }
2249
2250 my $committotal = scalar(@commits);
2251 my $commitcount = 0;
2252
2253 # Load the head table into $head (for cached lookups during the update process)
2254 foreach my $file ( @{$self->gethead()} )
2255 {
2256 $head->{$file->{name}} = $file;
2257 }
2258
2259 foreach my $commit ( @commits )
2260 {
2261 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2262 if (defined $lastpicked)
2263 {
2264 if (!in_array($lastpicked, @{$commit->{parents}}))
2265 {
2266 # skip, we'll see this delta
2267 # as part of a merge later
2268 # warn "skipping off-track $commit->{hash}\n";
2269 next;
2270 } elsif (@{$commit->{parents}} > 1) {
2271 # it is a merge commit, for each parent that is
2272 # not $lastpicked, see if we can get a log
2273 # from the merge-base to that parent to put it
2274 # in the message as a merge summary.
2275 my @parents = @{$commit->{parents}};
2276 foreach my $parent (@parents) {
2277 # git-merge-base can potentially (but rarely) throw
2278 # several candidate merge bases. let's assume
2279 # that the first one is the best one.
2280 if ($parent eq $lastpicked) {
2281 next;
2282 }
2283 open my $p, 'git-merge-base '. $lastpicked . ' '
2284 . $parent . '|';
2285 my @output = (<$p>);
2286 close $p;
2287 my $base = join('', @output);
2288 chomp $base;
2289 if ($base) {
2290 my @merged;
2291 # print "want to log between $base $parent \n";
2292 open(GITLOG, '-|', 'git-log', "$base..$parent")
2293 or die "Cannot call git-log: $!";
2294 my $mergedhash;
2295 while (<GITLOG>) {
2296 chomp;
2297 if (!defined $mergedhash) {
2298 if (m/^commit\s+(.+)$/) {
2299 $mergedhash = $1;
2300 } else {
2301 next;
2302 }
2303 } else {
2304 # grab the first line that looks non-rfc822
2305 # aka has content after leading space
2306 if (m/^\s+(\S.*)$/) {
2307 my $title = $1;
2308 $title = substr($title,0,100); # truncate
2309 unshift @merged, "$mergedhash $title";
2310 undef $mergedhash;
2311 }
2312 }
2313 }
2314 close GITLOG;
2315 if (@merged) {
2316 $commit->{mergemsg} = $commit->{message};
2317 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2318 foreach my $summary (@merged) {
2319 $commit->{mergemsg} .= "\t$summary\n";
2320 }
2321 $commit->{mergemsg} .= "\n\n";
2322 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2323 }
2324 }
2325 }
2326 }
2327 }
2328
2329 # convert the date to CVS-happy format
2330 $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2331
2332 if ( defined ( $lastpicked ) )
2333 {
2334 my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2335 while ( <FILELIST> )
2336 {
2337 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 )
2338 {
2339 die("Couldn't process git-diff-tree line : $_");
2340 }
2341
2342 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2343
2344 my $git_perms = "";
2345 $git_perms .= "r" if ( $1 & 4 );
2346 $git_perms .= "w" if ( $1 & 2 );
2347 $git_perms .= "x" if ( $1 & 1 );
2348 $git_perms = "rw" if ( $git_perms eq "" );
2349
2350 if ( $3 eq "D" )
2351 {
2352 #$log->debug("DELETE $4");
2353 $head->{$4} = {
2354 name => $4,
2355 revision => $head->{$4}{revision} + 1,
2356 filehash => "deleted",
2357 commithash => $commit->{hash},
2358 modified => $commit->{date},
2359 author => $commit->{author},
2360 mode => $git_perms,
2361 };
96256bba 2362 $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
2363 }
2364 elsif ( $3 eq "M" )
2365 {
2366 #$log->debug("MODIFIED $4");
2367 $head->{$4} = {
2368 name => $4,
2369 revision => $head->{$4}{revision} + 1,
2370 filehash => $2,
2371 commithash => $commit->{hash},
2372 modified => $commit->{date},
2373 author => $commit->{author},
2374 mode => $git_perms,
2375 };
96256bba 2376 $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
2377 }
2378 elsif ( $3 eq "A" )
2379 {
2380 #$log->debug("ADDED $4");
2381 $head->{$4} = {
2382 name => $4,
2383 revision => 1,
2384 filehash => $2,
2385 commithash => $commit->{hash},
2386 modified => $commit->{date},
2387 author => $commit->{author},
2388 mode => $git_perms,
2389 };
96256bba 2390 $self->insert_rev($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
2391 }
2392 else
2393 {
2394 $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2395 die;
2396 }
2397 }
2398 close FILELIST;
2399 } else {
2400 # this is used to detect files removed from the repo
2401 my $seen_files = {};
2402
2403 my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2404 while ( <FILELIST> )
2405 {
2406 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2407 {
2408 die("Couldn't process git-ls-tree line : $_");
2409 }
2410
2411 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2412
2413 $seen_files->{$git_filename} = 1;
2414
2415 my ( $oldhash, $oldrevision, $oldmode ) = (
2416 $head->{$git_filename}{filehash},
2417 $head->{$git_filename}{revision},
2418 $head->{$git_filename}{mode}
2419 );
2420
2421 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2422 {
2423 $git_perms = "";
2424 $git_perms .= "r" if ( $1 & 4 );
2425 $git_perms .= "w" if ( $1 & 2 );
2426 $git_perms .= "x" if ( $1 & 1 );
2427 } else {
2428 $git_perms = "rw";
2429 }
2430
2431 # unless the file exists with the same hash, we need to update it ...
2432 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2433 {
2434 my $newrevision = ( $oldrevision or 0 ) + 1;
2435
2436 $head->{$git_filename} = {
2437 name => $git_filename,
2438 revision => $newrevision,
2439 filehash => $git_hash,
2440 commithash => $commit->{hash},
2441 modified => $commit->{date},
2442 author => $commit->{author},
2443 mode => $git_perms,
2444 };
2445
2446
96256bba 2447 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
2448 }
2449 }
2450 close FILELIST;
2451
2452 # Detect deleted files
2453 foreach my $file ( keys %$head )
2454 {
2455 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2456 {
2457 $head->{$file}{revision}++;
2458 $head->{$file}{filehash} = "deleted";
2459 $head->{$file}{commithash} = $commit->{hash};
2460 $head->{$file}{modified} = $commit->{date};
2461 $head->{$file}{author} = $commit->{author};
2462
96256bba 2463 $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
3fda8c4c
ML
2464 }
2465 }
2466 # END : "Detect deleted files"
2467 }
2468
2469
2470 if (exists $commit->{mergemsg})
2471 {
96256bba 2472 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
3fda8c4c
ML
2473 }
2474
2475 $lastpicked = $commit->{hash};
2476
2477 $self->_set_prop("last_commit", $commit->{hash});
2478 }
2479
96256bba 2480 $self->delete_head();
3fda8c4c
ML
2481 foreach my $file ( keys %$head )
2482 {
96256bba 2483 $self->insert_head(
3fda8c4c
ML
2484 $file,
2485 $head->{$file}{revision},
2486 $head->{$file}{filehash},
2487 $head->{$file}{commithash},
2488 $head->{$file}{modified},
2489 $head->{$file}{author},
2490 $head->{$file}{mode},
2491 );
2492 }
2493 # invalidate the gethead cache
2494 $self->{gethead_cache} = undef;
2495
2496
2497 # Ending exclusive lock here
2498 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2499}
2500
96256bba
JS
2501sub insert_rev
2502{
2503 my $self = shift;
2504 my $name = shift;
2505 my $revision = shift;
2506 my $filehash = shift;
2507 my $commithash = shift;
2508 my $modified = shift;
2509 my $author = shift;
2510 my $mode = shift;
2511
2512 my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2513 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2514}
2515
2516sub insert_mergelog
2517{
2518 my $self = shift;
2519 my $key = shift;
2520 my $value = shift;
2521
2522 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2523 $insert_mergelog->execute($key, $value);
2524}
2525
2526sub delete_head
2527{
2528 my $self = shift;
2529
2530 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2531 $delete_head->execute();
2532}
2533
2534sub insert_head
2535{
2536 my $self = shift;
2537 my $name = shift;
2538 my $revision = shift;
2539 my $filehash = shift;
2540 my $commithash = shift;
2541 my $modified = shift;
2542 my $author = shift;
2543 my $mode = shift;
2544
2545 my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2546 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2547}
2548
3fda8c4c
ML
2549sub _headrev
2550{
2551 my $self = shift;
2552 my $filename = shift;
2553
2554 my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2555 $db_query->execute($filename);
2556 my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2557
2558 return ( $hash, $revision, $mode );
2559}
2560
2561sub _get_prop
2562{
2563 my $self = shift;
2564 my $key = shift;
2565
2566 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2567 $db_query->execute($key);
2568 my ( $value ) = $db_query->fetchrow_array;
2569
2570 return $value;
2571}
2572
2573sub _set_prop
2574{
2575 my $self = shift;
2576 my $key = shift;
2577 my $value = shift;
2578
2579 my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2580 $db_query->execute($value, $key);
2581
2582 unless ( $db_query->rows )
2583 {
2584 $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2585 $db_query->execute($key, $value);
2586 }
2587
2588 return $value;
2589}
2590
2591=head2 gethead
2592
2593=cut
2594
2595sub gethead
2596{
2597 my $self = shift;
2598
2599 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2600
501c7372 2601 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
3fda8c4c
ML
2602 $db_query->execute();
2603
2604 my $tree = [];
2605 while ( my $file = $db_query->fetchrow_hashref )
2606 {
2607 push @$tree, $file;
2608 }
2609
2610 $self->{gethead_cache} = $tree;
2611
2612 return $tree;
2613}
2614
2615=head2 getlog
2616
2617=cut
2618
2619sub getlog
2620{
2621 my $self = shift;
2622 my $filename = shift;
2623
2624 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2625 $db_query->execute($filename);
2626
2627 my $tree = [];
2628 while ( my $file = $db_query->fetchrow_hashref )
2629 {
2630 push @$tree, $file;
2631 }
2632
2633 return $tree;
2634}
2635
2636=head2 getmeta
2637
2638This function takes a filename (with path) argument and returns a hashref of
2639metadata for that file.
2640
2641=cut
2642
2643sub getmeta
2644{
2645 my $self = shift;
2646 my $filename = shift;
2647 my $revision = shift;
2648
2649 my $db_query;
2650 if ( defined($revision) and $revision =~ /^\d+$/ )
2651 {
2652 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2653 $db_query->execute($filename, $revision);
2654 }
2655 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2656 {
2657 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2658 $db_query->execute($filename, $revision);
2659 } else {
2660 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2661 $db_query->execute($filename);
2662 }
2663
2664 return $db_query->fetchrow_hashref;
2665}
2666
2667=head2 commitmessage
2668
2669this function takes a commithash and returns the commit message for that commit
2670
2671=cut
2672sub commitmessage
2673{
2674 my $self = shift;
2675 my $commithash = shift;
2676
2677 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2678
2679 my $db_query;
2680 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2681 $db_query->execute($commithash);
2682
2683 my ( $message ) = $db_query->fetchrow_array;
2684
2685 if ( defined ( $message ) )
2686 {
2687 $message .= " " if ( $message =~ /\n$/ );
2688 return $message;
2689 }
2690
2691 my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2692 shift @lines while ( $lines[0] =~ /\S/ );
2693 $message = join("",@lines);
2694 $message .= " " if ( $message =~ /\n$/ );
2695 return $message;
2696}
2697
2698=head2 gethistory
2699
2700This function takes a filename (with path) argument and returns an arrayofarrays
2701containing revision,filehash,commithash ordered by revision descending
2702
2703=cut
2704sub gethistory
2705{
2706 my $self = shift;
2707 my $filename = shift;
2708
2709 my $db_query;
2710 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2711 $db_query->execute($filename);
2712
2713 return $db_query->fetchall_arrayref;
2714}
2715
2716=head2 gethistorydense
2717
2718This function takes a filename (with path) argument and returns an arrayofarrays
2719containing revision,filehash,commithash ordered by revision descending.
2720
2721This version of gethistory skips deleted entries -- so it is useful for annotate.
2722The 'dense' part is a reference to a '--dense' option available for git-rev-list
2723and other git tools that depend on it.
2724
2725=cut
2726sub gethistorydense
2727{
2728 my $self = shift;
2729 my $filename = shift;
2730
2731 my $db_query;
2732 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2733 $db_query->execute($filename);
2734
2735 return $db_query->fetchall_arrayref;
2736}
2737
2738=head2 in_array()
2739
2740from Array::PAT - mimics the in_array() function
2741found in PHP. Yuck but works for small arrays.
2742
2743=cut
2744sub in_array
2745{
2746 my ($check, @array) = @_;
2747 my $retval = 0;
2748 foreach my $test (@array){
2749 if($check eq $test){
2750 $retval = 1;
2751 }
2752 }
2753 return $retval;
2754}
2755
2756=head2 safe_pipe_capture
2757
5348b6e7 2758an alternative to `command` that allows input to be passed as an array
3fda8c4c
ML
2759to work around shell problems with weird characters in arguments
2760
2761=cut
2762sub safe_pipe_capture {
2763
2764 my @output;
2765
2766 if (my $pid = open my $child, '-|') {
2767 @output = (<$child>);
2768 close $child or die join(' ',@_).": $! $?";
2769 } else {
2770 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2771 }
2772 return wantarray ? @output : join('',@output);
2773}
2774
2775
27761;