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