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