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