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