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