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