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