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