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