Merge part of 'jc/diff' into next
[git] / git-cvsserver.perl
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
18 use strict;
19 use warnings;
20
21 use Fcntl;
22 use File::Temp qw/tempdir tempfile/;
23 use File::Basename;
24
25 my $log = GITCVS::log->new();
26 my $cfg;
27
28 my $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
48 my $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,
56     'Questionable'    => \&req_Questionable,
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,
67     'rlog'            => \&req_log,
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.
84 my $state = {};
85 $log->info("--------------- STARTING -----------------");
86
87 my $TEMP_DIR = tempdir( CLEANUP => 1 );
88 $log->debug("Temporary directory is '$TEMP_DIR'");
89
90 # Keep going until the client closes the connection
91 while (<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.
118 sub 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.
134 sub 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.
172 sub 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.
183 sub 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.
195 sub 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.
219 sub 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.
248 sub 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.
270 sub 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.
329 sub 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.
406 sub 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 `/'.
455 sub 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
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.
471 sub 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
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.
487 sub 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:
521 sub 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.
552 sub 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
574     # instruct the client that we're checking out to $checkout_path
575     print "E cvs server: updating $checkout_path\n";
576
577     foreach my $git ( @{$updater->gethead} )
578     {
579         # Don't want to check out deleted files
580         next if ( $git->{filehash} eq "deleted" );
581
582         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
583
584         # modification time of this file
585         print "Mod-time $git->{modified}\n";
586
587         # print some information to the client
588         print "MT +updated\n";
589         print "MT text U \n";
590         if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
591         {
592             print "MT fname $checkout_path/$git->{dir}$git->{name}\n";
593         } else {
594             print "MT fname $checkout_path/$git->{name}\n";
595         }
596         print "MT newline\n";
597         print "MT -updated\n";
598
599         # instruct client we're sending a file to put in this path
600         print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
601
602         print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
603
604         # this is an "entries" line
605         print "/$git->{name}/1.$git->{revision}///\n";
606         # permissions
607         print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
608
609         # transmit file
610         transmitfile($git->{filehash});
611     }
612
613     print "ok\n";
614
615     statecleanup();
616 }
617
618 # update \n
619 #     Response expected: yes. Actually do a cvs update command. This uses any
620 #     previous Argument, Directory, Entry, or Modified requests, if they have
621 #     been sent. The last Directory sent specifies the working directory at the
622 #     time of the operation. The -I option is not used--files which the client
623 #     can decide whether to ignore are not mentioned and the client sends the
624 #     Questionable request for others.
625 sub req_update
626 {
627     my ( $cmd, $data ) = @_;
628
629     $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
630
631     argsplit("update");
632
633     #
634     # It may just be a client exploring the available heads/modukles
635     # in that case, list them as top level directories and leave it
636     # at that. Eclipse uses this technique to offer you a list of
637     # projects (heads in this case) to checkout.
638     #
639     if ($state->{module} eq '') {
640         print "E cvs update: Updating .\n";
641         opendir HEADS, $state->{CVSROOT} . '/refs/heads';
642         while (my $head = readdir(HEADS)) {
643             if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
644                 print "E cvs update: New directory `$head'\n";
645             }
646         }
647         closedir HEADS;
648         print "ok\n";
649         return 1;
650     }
651
652
653     # Grab a handle to the SQLite db and do any necessary updates
654     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
655
656     $updater->update();
657
658     # if no files were specified, we need to work out what files we should be providing status on ...
659     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
660
661     #$log->debug("update state : " . Dumper($state));
662
663     # foreach file specified on the commandline ...
664     foreach my $filename ( @{$state->{args}} )
665     {
666         $filename = filecleanup($filename);
667
668         # if we have a -C we should pretend we never saw modified stuff
669         if ( exists ( $state->{opt}{C} ) )
670         {
671             delete $state->{entries}{$filename}{modified_hash};
672             delete $state->{entries}{$filename}{modified_filename};
673             $state->{entries}{$filename}{unchanged} = 1;
674         }
675
676         my $meta;
677         if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
678         {
679             $meta = $updater->getmeta($filename, $1);
680         } else {
681             $meta = $updater->getmeta($filename);
682         }
683
684         next unless ( $meta->{revision} );
685
686         my $oldmeta = $meta;
687
688         my $wrev = revparse($filename);
689
690         # If the working copy is an old revision, lets get that version too for comparison.
691         if ( defined($wrev) and $wrev != $meta->{revision} )
692         {
693             $oldmeta = $updater->getmeta($filename, $wrev);
694         }
695
696         #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
697
698         # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified _and_ the user hasn't specified -C
699         next if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{unchanged} and not exists ( $state->{opt}{C} ) );
700
701         if ( $meta->{filehash} eq "deleted" )
702         {
703             my ( $filepart, $dirpart ) = filenamesplit($filename);
704
705             $log->info("Removing '$filename' from working copy (no longer in the repo)");
706
707             print "E cvs update: `$filename' is no longer in the repository\n";
708             print "Removed $dirpart\n";
709             print "$filepart\n";
710         }
711         elsif ( not defined ( $state->{entries}{$filename}{modified_hash} ) or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} )
712         {
713             $log->info("Updating '$filename'");
714             # normal update, just send the new revision (either U=Update, or A=Add, or R=Remove)
715             print "MT +updated\n";
716             print "MT text U\n";
717             print "MT fname $filename\n";
718             print "MT newline\n";
719             print "MT -updated\n";
720
721             my ( $filepart, $dirpart ) = filenamesplit($filename);
722             $dirpart =~ s/^$state->{directory}//;
723
724             if ( defined ( $wrev ) )
725             {
726                 # instruct client we're sending a file to put in this path as a replacement
727                 print "Update-existing $dirpart\n";
728                 $log->debug("Updating existing file 'Update-existing $dirpart'");
729             } else {
730                 # instruct client we're sending a file to put in this path as a new file
731                 print "Created $dirpart\n";
732                 $log->debug("Creating new file 'Created $dirpart'");
733             }
734             print $state->{CVSROOT} . "/$state->{module}/$filename\n";
735
736             # this is an "entries" line
737             $log->debug("/$filepart/1.$meta->{revision}///");
738             print "/$filepart/1.$meta->{revision}///\n";
739
740             # permissions
741             $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
742             print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
743
744             # transmit file
745             transmitfile($meta->{filehash});
746         } else {
747             my ( $filepart, $dirpart ) = filenamesplit($meta->{name});
748
749             my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
750
751             chdir $dir;
752             my $file_local = $filepart . ".mine";
753             system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
754             my $file_old = $filepart . "." . $oldmeta->{revision};
755             transmitfile($oldmeta->{filehash}, $file_old);
756             my $file_new = $filepart . "." . $meta->{revision};
757             transmitfile($meta->{filehash}, $file_new);
758
759             # we need to merge with the local changes ( M=successful merge, C=conflict merge )
760             $log->info("Merging $file_local, $file_old, $file_new");
761
762             $log->debug("Temporary directory for merge is $dir");
763
764             my $return = system("merge", $file_local, $file_old, $file_new);
765             $return >>= 8;
766
767             if ( $return == 0 )
768             {
769                 $log->info("Merged successfully");
770                 print "M M $filename\n";
771                 $log->debug("Update-existing $dirpart");
772                 print "Update-existing $dirpart\n";
773                 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
774                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
775                 $log->debug("/$filepart/1.$meta->{revision}///");
776                 print "/$filepart/1.$meta->{revision}///\n";
777             }
778             elsif ( $return == 1 )
779             {
780                 $log->info("Merged with conflicts");
781                 print "M C $filename\n";
782                 print "Update-existing $dirpart\n";
783                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
784                 print "/$filepart/1.$meta->{revision}/+//\n";
785             }
786             else
787             {
788                 $log->warn("Merge failed");
789                 next;
790             }
791
792             # permissions
793             $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
794             print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
795
796             # transmit file, format is single integer on a line by itself (file
797             # size) followed by the file contents
798             # TODO : we should copy files in blocks
799             my $data = `cat $file_local`;
800             $log->debug("File size : " . length($data));
801             print length($data) . "\n";
802             print $data;
803
804             chdir "/";
805         }
806
807     }
808
809     print "ok\n";
810 }
811
812 sub req_ci
813 {
814     my ( $cmd, $data ) = @_;
815
816     argsplit("ci");
817
818     #$log->debug("State : " . Dumper($state));
819
820     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
821
822     if ( -e $state->{CVSROOT} . "/index" )
823     {
824         print "error 1 Index already exists in git repo\n";
825         exit;
826     }
827
828     my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
829     unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )
830     {
831         print "error 1 Lock file '$lockfile' already exists, please try again\n";
832         exit;
833     }
834
835     # Grab a handle to the SQLite db and do any necessary updates
836     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
837     $updater->update();
838
839     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
840     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
841     $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
842
843     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
844     $ENV{GIT_INDEX_FILE} = $file_index;
845
846     chdir $tmpdir;
847
848     # populate the temporary index based
849     system("git-read-tree", $state->{module});
850     unless ($? == 0)
851     {
852         die "Error running git-read-tree $state->{module} $file_index $!";
853     }
854     $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
855
856
857     my @committedfiles = ();
858
859     # foreach file specified on the commandline ...
860     foreach my $filename ( @{$state->{args}} )
861     {
862         $filename = filecleanup($filename);
863
864         next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
865
866         my $meta = $updater->getmeta($filename);
867
868         my $wrev = revparse($filename);
869
870         my ( $filepart, $dirpart ) = filenamesplit($filename);
871
872         # do a checkout of the file if it part of this tree
873         if ($wrev) {
874             system('git-checkout-index', '-f', '-u', $filename);
875             unless ($? == 0) {
876                 die "Error running git-checkout-index -f -u $filename : $!";
877             }
878         }
879
880         my $addflag = 0;
881         my $rmflag = 0;
882         $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
883         $addflag = 1 unless ( -e $filename );
884
885         # Do up to date checking
886         unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
887         {
888             # fail everything if an up to date check fails
889             print "error 1 Up to date check failed for $filename\n";
890             close LOCKFILE;
891             unlink($lockfile);
892             chdir "/";
893             exit;
894         }
895
896         push @committedfiles, $filename;
897         $log->info("Committing $filename");
898
899         system("mkdir","-p",$dirpart) unless ( -d $dirpart );
900
901         unless ( $rmflag )
902         {
903             $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
904             rename $state->{entries}{$filename}{modified_filename},$filename;
905
906             # Calculate modes to remove
907             my $invmode = "";
908             foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
909
910             $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
911             system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
912         }
913
914         if ( $rmflag )
915         {
916             $log->info("Removing file '$filename'");
917             unlink($filename);
918             system("git-update-index", "--remove", $filename);
919         }
920         elsif ( $addflag )
921         {
922             $log->info("Adding file '$filename'");
923             system("git-update-index", "--add", $filename);
924         } else {
925             $log->info("Updating file '$filename'");
926             system("git-update-index", $filename);
927         }
928     }
929
930     unless ( scalar(@committedfiles) > 0 )
931     {
932         print "E No files to commit\n";
933         print "ok\n";
934         close LOCKFILE;
935         unlink($lockfile);
936         chdir "/";
937         return;
938     }
939
940     my $treehash = `git-write-tree`;
941     my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
942     chomp $treehash;
943     chomp $parenthash;
944
945     $log->debug("Treehash : $treehash, Parenthash : $parenthash");
946
947     # write our commit message out if we have one ...
948     my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
949     print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
950     print $msg_fh "\n\nvia git-CVS emulator\n";
951     close $msg_fh;
952
953     my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
954     $log->info("Commit hash : $commithash");
955
956     unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
957     {
958         $log->warn("Commit failed (Invalid commit hash)");
959         print "error 1 Commit failed (unknown reason)\n";
960         close LOCKFILE;
961         unlink($lockfile);
962         chdir "/";
963         exit;
964     }
965
966     open FILE, ">", "$ENV{GIT_DIR}refs/heads/$state->{module}";
967     print FILE $commithash;
968     close FILE;
969
970     $updater->update();
971
972     # foreach file specified on the commandline ...
973     foreach my $filename ( @committedfiles )
974     {
975         $filename = filecleanup($filename);
976
977         my $meta = $updater->getmeta($filename);
978
979         my ( $filepart, $dirpart ) = filenamesplit($filename);
980
981         $log->debug("Checked-in $dirpart : $filename");
982
983         if ( $meta->{filehash} eq "deleted" )
984         {
985             print "Remove-entry $dirpart\n";
986             print "$filename\n";
987         } else {
988             print "Checked-in $dirpart\n";
989             print "$filename\n";
990             print "/$filepart/1.$meta->{revision}///\n";
991         }
992     }
993
994     close LOCKFILE;
995     unlink($lockfile);
996     chdir "/";
997
998     print "ok\n";
999 }
1000
1001 sub req_status
1002 {
1003     my ( $cmd, $data ) = @_;
1004
1005     argsplit("status");
1006
1007     $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1008     #$log->debug("status state : " . Dumper($state));
1009
1010     # Grab a handle to the SQLite db and do any necessary updates
1011     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1012     $updater->update();
1013
1014     # if no files were specified, we need to work out what files we should be providing status on ...
1015     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1016
1017     # foreach file specified on the commandline ...
1018     foreach my $filename ( @{$state->{args}} )
1019     {
1020         $filename = filecleanup($filename);
1021
1022         my $meta = $updater->getmeta($filename);
1023         my $oldmeta = $meta;
1024
1025         my $wrev = revparse($filename);
1026
1027         # If the working copy is an old revision, lets get that version too for comparison.
1028         if ( defined($wrev) and $wrev != $meta->{revision} )
1029         {
1030             $oldmeta = $updater->getmeta($filename, $wrev);
1031         }
1032
1033         # TODO : All possible statuses aren't yet implemented
1034         my $status;
1035         # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1036         $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1037                                     and
1038                                     ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1039                                       or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1040                                    );
1041
1042         # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1043         $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1044                                           and
1045                                           ( $state->{entries}{$filename}{unchanged}
1046                                             or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1047                                         );
1048
1049         # Need checkout if it exists in the repo but doesn't have a working copy
1050         $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1051
1052         # Locally modified if working copy and repo copy have the same revision but there are local changes
1053         $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1054
1055         # Needs Merge if working copy revision is less than repo copy and there are local changes
1056         $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1057
1058         $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1059         $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1060         $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1061         $status ||= "File had conflicts on merge" if ( 0 );
1062
1063         $status ||= "Unknown";
1064
1065         print "M ===================================================================\n";
1066         print "M File: $filename\tStatus: $status\n";
1067         if ( defined($state->{entries}{$filename}{revision}) )
1068         {
1069             print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1070         } else {
1071             print "M Working revision:\tNo entry for $filename\n";
1072         }
1073         if ( defined($meta->{revision}) )
1074         {
1075             print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1076             print "M Sticky Tag:\t\t(none)\n";
1077             print "M Sticky Date:\t\t(none)\n";
1078             print "M Sticky Options:\t\t(none)\n";
1079         } else {
1080             print "M Repository revision:\tNo revision control file\n";
1081         }
1082         print "M\n";
1083     }
1084
1085     print "ok\n";
1086 }
1087
1088 sub req_diff
1089 {
1090     my ( $cmd, $data ) = @_;
1091
1092     argsplit("diff");
1093
1094     $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1095     #$log->debug("status state : " . Dumper($state));
1096
1097     my ($revision1, $revision2);
1098     if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1099     {
1100         $revision1 = $state->{opt}{r}[0];
1101         $revision2 = $state->{opt}{r}[1];
1102     } else {
1103         $revision1 = $state->{opt}{r};
1104     }
1105
1106     $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1107     $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1108
1109     $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1110
1111     # Grab a handle to the SQLite db and do any necessary updates
1112     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1113     $updater->update();
1114
1115     # if no files were specified, we need to work out what files we should be providing status on ...
1116     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1117
1118     # foreach file specified on the commandline ...
1119     foreach my $filename ( @{$state->{args}} )
1120     {
1121         $filename = filecleanup($filename);
1122
1123         my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1124
1125         my $wrev = revparse($filename);
1126
1127         # We need _something_ to diff against
1128         next unless ( defined ( $wrev ) );
1129
1130         # if we have a -r switch, use it
1131         if ( defined ( $revision1 ) )
1132         {
1133             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1134             $meta1 = $updater->getmeta($filename, $revision1);
1135             unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1136             {
1137                 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1138                 next;
1139             }
1140             transmitfile($meta1->{filehash}, $file1);
1141         }
1142         # otherwise we just use the working copy revision
1143         else
1144         {
1145             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1146             $meta1 = $updater->getmeta($filename, $wrev);
1147             transmitfile($meta1->{filehash}, $file1);
1148         }
1149
1150         # if we have a second -r switch, use it too
1151         if ( defined ( $revision2 ) )
1152         {
1153             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1154             $meta2 = $updater->getmeta($filename, $revision2);
1155
1156             unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1157             {
1158                 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1159                 next;
1160             }
1161
1162             transmitfile($meta2->{filehash}, $file2);
1163         }
1164         # otherwise we just use the working copy
1165         else
1166         {
1167             $file2 = $state->{entries}{$filename}{modified_filename};
1168         }
1169
1170         # if we have been given -r, and we don't have a $file2 yet, lets get one
1171         if ( defined ( $revision1 ) and not defined ( $file2 ) )
1172         {
1173             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1174             $meta2 = $updater->getmeta($filename, $wrev);
1175             transmitfile($meta2->{filehash}, $file2);
1176         }
1177
1178         # We need to have retrieved something useful
1179         next unless ( defined ( $meta1 ) );
1180
1181         # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1182         next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1183                   and
1184                    ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1185                      or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1186                   );
1187
1188         # Apparently we only show diffs for locally modified files
1189         next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1190
1191         print "M Index: $filename\n";
1192         print "M ===================================================================\n";
1193         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1194         print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1195         print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1196         print "M diff ";
1197         foreach my $opt ( keys %{$state->{opt}} )
1198         {
1199             if ( ref $state->{opt}{$opt} eq "ARRAY" )
1200             {
1201                 foreach my $value ( @{$state->{opt}{$opt}} )
1202                 {
1203                     print "-$opt $value ";
1204                 }
1205             } else {
1206                 print "-$opt ";
1207                 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1208             }
1209         }
1210         print "$filename\n";
1211
1212         $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1213
1214         ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1215
1216         if ( exists $state->{opt}{u} )
1217         {
1218             system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1219         } else {
1220             system("diff $file1 $file2 > $filediff");
1221         }
1222
1223         while ( <$fh> )
1224         {
1225             print "M $_";
1226         }
1227         close $fh;
1228     }
1229
1230     print "ok\n";
1231 }
1232
1233 sub req_log
1234 {
1235     my ( $cmd, $data ) = @_;
1236
1237     argsplit("log");
1238
1239     $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1240     #$log->debug("log state : " . Dumper($state));
1241
1242     my ( $minrev, $maxrev );
1243     if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1244     {
1245         my $control = $2;
1246         $minrev = $1;
1247         $maxrev = $3;
1248         $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1249         $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1250         $minrev++ if ( defined($minrev) and $control eq "::" );
1251     }
1252
1253     # Grab a handle to the SQLite db and do any necessary updates
1254     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1255     $updater->update();
1256
1257     # if no files were specified, we need to work out what files we should be providing status on ...
1258     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1259
1260     # foreach file specified on the commandline ...
1261     foreach my $filename ( @{$state->{args}} )
1262     {
1263         $filename = filecleanup($filename);
1264
1265         my $headmeta = $updater->getmeta($filename);
1266
1267         my $revisions = $updater->getlog($filename);
1268         my $totalrevisions = scalar(@$revisions);
1269
1270         if ( defined ( $minrev ) )
1271         {
1272             $log->debug("Removing revisions less than $minrev");
1273             while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1274             {
1275                 pop @$revisions;
1276             }
1277         }
1278         if ( defined ( $maxrev ) )
1279         {
1280             $log->debug("Removing revisions greater than $maxrev");
1281             while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1282             {
1283                 shift @$revisions;
1284             }
1285         }
1286
1287         next unless ( scalar(@$revisions) );
1288
1289         print "M \n";
1290         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1291         print "M Working file: $filename\n";
1292         print "M head: 1.$headmeta->{revision}\n";
1293         print "M branch:\n";
1294         print "M locks: strict\n";
1295         print "M access list:\n";
1296         print "M symbolic names:\n";
1297         print "M keyword substitution: kv\n";
1298         print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1299         print "M description:\n";
1300
1301         foreach my $revision ( @$revisions )
1302         {
1303             print "M ----------------------------\n";
1304             print "M revision 1.$revision->{revision}\n";
1305             # reformat the date for log output
1306             $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}) );
1307             $revision->{author} =~ s/\s+.*//;
1308             $revision->{author} =~ s/^(.{8}).*/$1/;
1309             print "M date: $revision->{modified};  author: $revision->{author};  state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . ";  lines: +2 -3\n";
1310             my $commitmessage = $updater->commitmessage($revision->{commithash});
1311             $commitmessage =~ s/^/M /mg;
1312             print $commitmessage . "\n";
1313         }
1314         print "M =============================================================================\n";
1315     }
1316
1317     print "ok\n";
1318 }
1319
1320 sub req_annotate
1321 {
1322     my ( $cmd, $data ) = @_;
1323
1324     argsplit("annotate");
1325
1326     $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1327     #$log->debug("status state : " . Dumper($state));
1328
1329     # Grab a handle to the SQLite db and do any necessary updates
1330     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1331     $updater->update();
1332
1333     # if no files were specified, we need to work out what files we should be providing annotate on ...
1334     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1335
1336     # we'll need a temporary checkout dir
1337     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1338     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1339     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1340
1341     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1342     $ENV{GIT_INDEX_FILE} = $file_index;
1343
1344     chdir $tmpdir;
1345
1346     # foreach file specified on the commandline ...
1347     foreach my $filename ( @{$state->{args}} )
1348     {
1349         $filename = filecleanup($filename);
1350
1351         my $meta = $updater->getmeta($filename);
1352
1353         next unless ( $meta->{revision} );
1354
1355         # get all the commits that this file was in
1356         # in dense format -- aka skip dead revisions
1357         my $revisions   = $updater->gethistorydense($filename);
1358         my $lastseenin  = $revisions->[0][2];
1359
1360         # populate the temporary index based on the latest commit were we saw
1361         # the file -- but do it cheaply without checking out any files
1362         # TODO: if we got a revision from the client, use that instead
1363         # to look up the commithash in sqlite (still good to default to
1364         # the current head as we do now)
1365         system("git-read-tree", $lastseenin);
1366         unless ($? == 0)
1367         {
1368             die "Error running git-read-tree $lastseenin $file_index $!";
1369         }
1370         $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1371
1372         # do a checkout of the file
1373         system('git-checkout-index', '-f', '-u', $filename);
1374         unless ($? == 0) {
1375             die "Error running git-checkout-index -f -u $filename : $!";
1376         }
1377
1378         $log->info("Annotate $filename");
1379
1380         # Prepare a file with the commits from the linearized
1381         # history that annotate should know about. This prevents
1382         # git-jsannotate telling us about commits we are hiding
1383         # from the client.
1384
1385         open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1386         for (my $i=0; $i < @$revisions; $i++)
1387         {
1388             print ANNOTATEHINTS $revisions->[$i][2];
1389             if ($i+1 < @$revisions) { # have we got a parent?
1390                 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1391             }
1392             print ANNOTATEHINTS "\n";
1393         }
1394
1395         print ANNOTATEHINTS "\n";
1396         close ANNOTATEHINTS;
1397
1398         my $annotatecmd = 'git-annotate';
1399         open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1400             or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1401         my $metadata = {};
1402         print "E Annotations for $filename\n";
1403         print "E ***************\n";
1404         while ( <ANNOTATE> )
1405         {
1406             if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1407             {
1408                 my $commithash = $1;
1409                 my $data = $2;
1410                 unless ( defined ( $metadata->{$commithash} ) )
1411                 {
1412                     $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1413                     $metadata->{$commithash}{author} =~ s/\s+.*//;
1414                     $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1415                     $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1416                 }
1417                 printf("M 1.%-5d      (%-8s %10s): %s\n",
1418                     $metadata->{$commithash}{revision},
1419                     $metadata->{$commithash}{author},
1420                     $metadata->{$commithash}{modified},
1421                     $data
1422                 );
1423             } else {
1424                 $log->warn("Error in annotate output! LINE: $_");
1425                 print "E Annotate error \n";
1426                 next;
1427             }
1428         }
1429         close ANNOTATE;
1430     }
1431
1432     # done; get out of the tempdir
1433     chdir "/";
1434
1435     print "ok\n";
1436
1437 }
1438
1439 # This method takes the state->{arguments} array and produces two new arrays.
1440 # The first is $state->{args} which is everything before the '--' argument, and
1441 # the second is $state->{files} which is everything after it.
1442 sub argsplit
1443 {
1444     return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1445
1446     my $type = shift;
1447
1448     $state->{args} = [];
1449     $state->{files} = [];
1450     $state->{opt} = {};
1451
1452     if ( defined($type) )
1453     {
1454         my $opt = {};
1455         $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" );
1456         $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1457         $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" );
1458         $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1459         $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1460         $opt = { k => 1, m => 1 } if ( $type eq "add" );
1461         $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1462         $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" );
1463
1464
1465         while ( scalar ( @{$state->{arguments}} ) > 0 )
1466         {
1467             my $arg = shift @{$state->{arguments}};
1468
1469             next if ( $arg eq "--" );
1470             next unless ( $arg =~ /\S/ );
1471
1472             # if the argument looks like a switch
1473             if ( $arg =~ /^-(\w)(.*)/ )
1474             {
1475                 # if it's a switch that takes an argument
1476                 if ( $opt->{$1} )
1477                 {
1478                     # If this switch has already been provided
1479                     if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1480                     {
1481                         $state->{opt}{$1} = [ $state->{opt}{$1} ];
1482                         if ( length($2) > 0 )
1483                         {
1484                             push @{$state->{opt}{$1}},$2;
1485                         } else {
1486                             push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1487                         }
1488                     } else {
1489                         # if there's extra data in the arg, use that as the argument for the switch
1490                         if ( length($2) > 0 )
1491                         {
1492                             $state->{opt}{$1} = $2;
1493                         } else {
1494                             $state->{opt}{$1} = shift @{$state->{arguments}};
1495                         }
1496                     }
1497                 } else {
1498                     $state->{opt}{$1} = undef;
1499                 }
1500             }
1501             else
1502             {
1503                 push @{$state->{args}}, $arg;
1504             }
1505         }
1506     }
1507     else
1508     {
1509         my $mode = 0;
1510
1511         foreach my $value ( @{$state->{arguments}} )
1512         {
1513             if ( $value eq "--" )
1514             {
1515                 $mode++;
1516                 next;
1517             }
1518             push @{$state->{args}}, $value if ( $mode == 0 );
1519             push @{$state->{files}}, $value if ( $mode == 1 );
1520         }
1521     }
1522 }
1523
1524 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1525 sub argsfromdir
1526 {
1527     my $updater = shift;
1528
1529     $state->{args} = [];
1530
1531     foreach my $file ( @{$updater->gethead} )
1532     {
1533         next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1534         next unless ( $file->{name} =~ s/^$state->{directory}// );
1535         push @{$state->{args}}, $file->{name};
1536     }
1537 }
1538
1539 # This method cleans up the $state variable after a command that uses arguments has run
1540 sub statecleanup
1541 {
1542     $state->{files} = [];
1543     $state->{args} = [];
1544     $state->{arguments} = [];
1545     $state->{entries} = {};
1546 }
1547
1548 sub revparse
1549 {
1550     my $filename = shift;
1551
1552     return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1553
1554     return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1555     return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1556
1557     return undef;
1558 }
1559
1560 # This method takes a file hash and does a CVS "file transfer" which transmits the
1561 # size of the file, and then the file contents.
1562 # If a second argument $targetfile is given, the file is instead written out to
1563 # a file by the name of $targetfile
1564 sub transmitfile
1565 {
1566     my $filehash = shift;
1567     my $targetfile = shift;
1568
1569     if ( defined ( $filehash ) and $filehash eq "deleted" )
1570     {
1571         $log->warn("filehash is 'deleted'");
1572         return;
1573     }
1574
1575     die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1576
1577     my $type = `git-cat-file -t $filehash`;
1578     chomp $type;
1579
1580     die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1581
1582     my $size = `git-cat-file -s $filehash`;
1583     chomp $size;
1584
1585     $log->debug("transmitfile($filehash) size=$size, type=$type");
1586
1587     if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1588     {
1589         if ( defined ( $targetfile ) )
1590         {
1591             open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1592             print NEWFILE $_ while ( <$fh> );
1593             close NEWFILE;
1594         } else {
1595             print "$size\n";
1596             print while ( <$fh> );
1597         }
1598         close $fh or die ("Couldn't close filehandle for transmitfile()");
1599     } else {
1600         die("Couldn't execute git-cat-file");
1601     }
1602 }
1603
1604 # This method takes a file name, and returns ( $dirpart, $filepart ) which
1605 # refers to the directory porition and the file portion of the filename
1606 # respectively
1607 sub filenamesplit
1608 {
1609     my $filename = shift;
1610
1611     my ( $filepart, $dirpart ) = ( $filename, "." );
1612     ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1613     $dirpart .= "/";
1614
1615     return ( $filepart, $dirpart );
1616 }
1617
1618 sub filecleanup
1619 {
1620     my $filename = shift;
1621
1622     return undef unless(defined($filename));
1623     if ( $filename =~ /^\// )
1624     {
1625         print "E absolute filenames '$filename' not supported by server\n";
1626         return undef;
1627     }
1628
1629     $filename =~ s/^\.\///g;
1630     $filename = $state->{directory} . $filename;
1631
1632     return $filename;
1633 }
1634
1635 package GITCVS::log;
1636
1637 ####
1638 #### Copyright The Open University UK - 2006.
1639 ####
1640 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1641 ####          Martin Langhoff <martin@catalyst.net.nz>
1642 ####
1643 ####
1644
1645 use strict;
1646 use warnings;
1647
1648 =head1 NAME
1649
1650 GITCVS::log
1651
1652 =head1 DESCRIPTION
1653
1654 This module provides very crude logging with a similar interface to
1655 Log::Log4perl
1656
1657 =head1 METHODS
1658
1659 =cut
1660
1661 =head2 new
1662
1663 Creates a new log object, optionally you can specify a filename here to
1664 indicate the file to log to. If no log file is specified, you can specifiy one
1665 later with method setfile, or indicate you no longer want logging with method
1666 nofile.
1667
1668 Until one of these methods is called, all log calls will buffer messages ready
1669 to write out.
1670
1671 =cut
1672 sub new
1673 {
1674     my $class = shift;
1675     my $filename = shift;
1676
1677     my $self = {};
1678
1679     bless $self, $class;
1680
1681     if ( defined ( $filename ) )
1682     {
1683         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1684     }
1685
1686     return $self;
1687 }
1688
1689 =head2 setfile
1690
1691 This methods takes a filename, and attempts to open that file as the log file.
1692 If successful, all buffered data is written out to the file, and any further
1693 logging is written directly to the file.
1694
1695 =cut
1696 sub setfile
1697 {
1698     my $self = shift;
1699     my $filename = shift;
1700
1701     if ( defined ( $filename ) )
1702     {
1703         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1704     }
1705
1706     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1707
1708     while ( my $line = shift @{$self->{buffer}} )
1709     {
1710         print {$self->{fh}} $line;
1711     }
1712 }
1713
1714 =head2 nofile
1715
1716 This method indicates no logging is going to be used. It flushes any entries in
1717 the internal buffer, and sets a flag to ensure no further data is put there.
1718
1719 =cut
1720 sub nofile
1721 {
1722     my $self = shift;
1723
1724     $self->{nolog} = 1;
1725
1726     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1727
1728     $self->{buffer} = [];
1729 }
1730
1731 =head2 _logopen
1732
1733 Internal method. Returns true if the log file is open, false otherwise.
1734
1735 =cut
1736 sub _logopen
1737 {
1738     my $self = shift;
1739
1740     return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
1741     return 0;
1742 }
1743
1744 =head2 debug info warn fatal
1745
1746 These four methods are wrappers to _log. They provide the actual interface for
1747 logging data.
1748
1749 =cut
1750 sub debug { my $self = shift; $self->_log("debug", @_); }
1751 sub info  { my $self = shift; $self->_log("info" , @_); }
1752 sub warn  { my $self = shift; $self->_log("warn" , @_); }
1753 sub fatal { my $self = shift; $self->_log("fatal", @_); }
1754
1755 =head2 _log
1756
1757 This is an internal method called by the logging functions. It generates a
1758 timestamp and pushes the logged line either to file, or internal buffer.
1759
1760 =cut
1761 sub _log
1762 {
1763     my $self = shift;
1764     my $level = shift;
1765
1766     return if ( $self->{nolog} );
1767
1768     my @time = localtime;
1769     my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
1770         $time[5] + 1900,
1771         $time[4] + 1,
1772         $time[3],
1773         $time[2],
1774         $time[1],
1775         $time[0],
1776         uc $level,
1777     );
1778
1779     if ( $self->_logopen )
1780     {
1781         print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
1782     } else {
1783         push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
1784     }
1785 }
1786
1787 =head2 DESTROY
1788
1789 This method simply closes the file handle if one is open
1790
1791 =cut
1792 sub DESTROY
1793 {
1794     my $self = shift;
1795
1796     if ( $self->_logopen )
1797     {
1798         close $self->{fh};
1799     }
1800 }
1801
1802 package GITCVS::updater;
1803
1804 ####
1805 #### Copyright The Open University UK - 2006.
1806 ####
1807 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1808 ####          Martin Langhoff <martin@catalyst.net.nz>
1809 ####
1810 ####
1811
1812 use strict;
1813 use warnings;
1814 use DBI;
1815
1816 =head1 METHODS
1817
1818 =cut
1819
1820 =head2 new
1821
1822 =cut
1823 sub new
1824 {
1825     my $class = shift;
1826     my $config = shift;
1827     my $module = shift;
1828     my $log = shift;
1829
1830     die "Need to specify a git repository" unless ( defined($config) and -d $config );
1831     die "Need to specify a module" unless ( defined($module) );
1832
1833     $class = ref($class) || $class;
1834
1835     my $self = {};
1836
1837     bless $self, $class;
1838
1839     $self->{dbdir} = $config . "/";
1840     die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
1841
1842     $self->{module} = $module;
1843     $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
1844
1845     $self->{git_path} = $config . "/";
1846
1847     $self->{log} = $log;
1848
1849     die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
1850
1851     $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
1852
1853     $self->{tables} = {};
1854     foreach my $table ( $self->{dbh}->tables )
1855     {
1856         $table =~ s/^"//;
1857         $table =~ s/"$//;
1858         $self->{tables}{$table} = 1;
1859     }
1860
1861     # Construct the revision table if required
1862     unless ( $self->{tables}{revision} )
1863     {
1864         $self->{dbh}->do("
1865             CREATE TABLE revision (
1866                 name       TEXT NOT NULL,
1867                 revision   INTEGER NOT NULL,
1868                 filehash   TEXT NOT NULL,
1869                 commithash TEXT NOT NULL,
1870                 author     TEXT NOT NULL,
1871                 modified   TEXT NOT NULL,
1872                 mode       TEXT NOT NULL
1873             )
1874         ");
1875     }
1876
1877     # Construct the revision table if required
1878     unless ( $self->{tables}{head} )
1879     {
1880         $self->{dbh}->do("
1881             CREATE TABLE head (
1882                 name       TEXT NOT NULL,
1883                 revision   INTEGER NOT NULL,
1884                 filehash   TEXT NOT NULL,
1885                 commithash TEXT NOT NULL,
1886                 author     TEXT NOT NULL,
1887                 modified   TEXT NOT NULL,
1888                 mode       TEXT NOT NULL
1889             )
1890         ");
1891     }
1892
1893     # Construct the properties table if required
1894     unless ( $self->{tables}{properties} )
1895     {
1896         $self->{dbh}->do("
1897             CREATE TABLE properties (
1898                 key        TEXT NOT NULL PRIMARY KEY,
1899                 value      TEXT
1900             )
1901         ");
1902     }
1903
1904     # Construct the commitmsgs table if required
1905     unless ( $self->{tables}{commitmsgs} )
1906     {
1907         $self->{dbh}->do("
1908             CREATE TABLE commitmsgs (
1909                 key        TEXT NOT NULL PRIMARY KEY,
1910                 value      TEXT
1911             )
1912         ");
1913     }
1914
1915     return $self;
1916 }
1917
1918 =head2 update
1919
1920 =cut
1921 sub update
1922 {
1923     my $self = shift;
1924
1925     # first lets get the commit list
1926     $ENV{GIT_DIR} = $self->{git_path};
1927
1928     # prepare database queries
1929     my $db_insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
1930     my $db_insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
1931     my $db_delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
1932     my $db_insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
1933
1934     my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
1935     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
1936     {
1937         die("Invalid module '$self->{module}'");
1938     }
1939
1940
1941     my $git_log;
1942     my $lastcommit = $self->_get_prop("last_commit");
1943
1944     # Start exclusive lock here...
1945     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
1946
1947     # TODO: log processing is memory bound
1948     # if we can parse into a 2nd file that is in reverse order
1949     # we can probably do something really efficient
1950     my @git_log_params = ('--parents', '--topo-order');
1951
1952     if (defined $lastcommit) {
1953         push @git_log_params, "$lastcommit..$self->{module}";
1954     } else {
1955         push @git_log_params, $self->{module};
1956     }
1957     open(GITLOG, '-|', 'git-log', @git_log_params) or die "Cannot call git-log: $!";
1958
1959     my @commits;
1960
1961     my %commit = ();
1962
1963     while ( <GITLOG> )
1964     {
1965         chomp;
1966         if (m/^commit\s+(.*)$/) {
1967             # on ^commit lines put the just seen commit in the stack
1968             # and prime things for the next one
1969             if (keys %commit) {
1970                 my %copy = %commit;
1971                 unshift @commits, \%copy;
1972                 %commit = ();
1973             }
1974             my @parents = split(m/\s+/, $1);
1975             $commit{hash} = shift @parents;
1976             $commit{parents} = \@parents;
1977         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
1978             # on rfc822-like lines seen before we see any message,
1979             # lowercase the entry and put it in the hash as key-value
1980             $commit{lc($1)} = $2;
1981         } else {
1982             # message lines - skip initial empty line
1983             # and trim whitespace
1984             if (!exists($commit{message}) && m/^\s*$/) {
1985                 # define it to mark the end of headers
1986                 $commit{message} = '';
1987                 next;
1988             }
1989             s/^\s+//; s/\s+$//; # trim ws
1990             $commit{message} .= $_ . "\n";
1991         }
1992     }
1993     close GITLOG;
1994
1995     unshift @commits, \%commit if ( keys %commit );
1996
1997     # Now all the commits are in the @commits bucket
1998     # ordered by time DESC. for each commit that needs processing,
1999     # determine whether it's following the last head we've seen or if
2000     # it's on its own branch, grab a file list, and add whatever's changed
2001     # NOTE: $lastcommit refers to the last commit from previous run
2002     #       $lastpicked is the last commit we picked in this run
2003     my $lastpicked;
2004     my $head = {};
2005     if (defined $lastcommit) {
2006         $lastpicked = $lastcommit;
2007     }
2008
2009     my $committotal = scalar(@commits);
2010     my $commitcount = 0;
2011
2012     # Load the head table into $head (for cached lookups during the update process)
2013     foreach my $file ( @{$self->gethead()} )
2014     {
2015         $head->{$file->{name}} = $file;
2016     }
2017
2018     foreach my $commit ( @commits )
2019     {
2020         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2021         if (defined $lastpicked)
2022         {
2023             if (!in_array($lastpicked, @{$commit->{parents}}))
2024             {
2025                 # skip, we'll see this delta
2026                 # as part of a merge later
2027                 # warn "skipping off-track  $commit->{hash}\n";
2028                 next;
2029             } elsif (@{$commit->{parents}} > 1) {
2030                 # it is a merge commit, for each parent that is
2031                 # not $lastpicked, see if we can get a log
2032                 # from the merge-base to that parent to put it
2033                 # in the message as a merge summary.
2034                 my @parents = @{$commit->{parents}};
2035                 foreach my $parent (@parents) {
2036                     # git-merge-base can potentially (but rarely) throw
2037                     # several candidate merge bases. let's assume
2038                     # that the first one is the best one.
2039                     if ($parent eq $lastpicked) {
2040                         next;
2041                     }
2042                     open my $p, 'git-merge-base '. $lastpicked . ' '
2043                     . $parent . '|';
2044                     my @output = (<$p>);
2045                     close $p;
2046                     my $base = join('', @output);
2047                     chomp $base;
2048                     if ($base) {
2049                         my @merged;
2050                         # print "want to log between  $base $parent \n";
2051                         open(GITLOG, '-|', 'git-log', "$base..$parent")
2052                         or die "Cannot call git-log: $!";
2053                         my $mergedhash;
2054                         while (<GITLOG>) {
2055                             chomp;
2056                             if (!defined $mergedhash) {
2057                                 if (m/^commit\s+(.+)$/) {
2058                                     $mergedhash = $1;
2059                                 } else {
2060                                     next;
2061                                 }
2062                             } else {
2063                                 # grab the first line that looks non-rfc822
2064                                 # aka has content after leading space
2065                                 if (m/^\s+(\S.*)$/) {
2066                                     my $title = $1;
2067                                     $title = substr($title,0,100); # truncate
2068                                     unshift @merged, "$mergedhash $title";
2069                                     undef $mergedhash;
2070                                 }
2071                             }
2072                         }
2073                         close GITLOG;
2074                         if (@merged) {
2075                             $commit->{mergemsg} = $commit->{message};
2076                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2077                             foreach my $summary (@merged) {
2078                                 $commit->{mergemsg} .= "\t$summary\n";
2079                             }
2080                             $commit->{mergemsg} .= "\n\n";
2081                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2082                         }
2083                     }
2084                 }
2085             }
2086         }
2087
2088         # convert the date to CVS-happy format
2089         $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2090
2091         if ( defined ( $lastpicked ) )
2092         {
2093             my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2094             while ( <FILELIST> )
2095             {
2096                 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 )
2097                 {
2098                     die("Couldn't process git-diff-tree line : $_");
2099                 }
2100
2101                 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2102
2103                 my $git_perms = "";
2104                 $git_perms .= "r" if ( $1 & 4 );
2105                 $git_perms .= "w" if ( $1 & 2 );
2106                 $git_perms .= "x" if ( $1 & 1 );
2107                 $git_perms = "rw" if ( $git_perms eq "" );
2108
2109                 if ( $3 eq "D" )
2110                 {
2111                     #$log->debug("DELETE   $4");
2112                     $head->{$4} = {
2113                         name => $4,
2114                         revision => $head->{$4}{revision} + 1,
2115                         filehash => "deleted",
2116                         commithash => $commit->{hash},
2117                         modified => $commit->{date},
2118                         author => $commit->{author},
2119                         mode => $git_perms,
2120                     };
2121                     $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2122                 }
2123                 elsif ( $3 eq "M" )
2124                 {
2125                     #$log->debug("MODIFIED $4");
2126                     $head->{$4} = {
2127                         name => $4,
2128                         revision => $head->{$4}{revision} + 1,
2129                         filehash => $2,
2130                         commithash => $commit->{hash},
2131                         modified => $commit->{date},
2132                         author => $commit->{author},
2133                         mode => $git_perms,
2134                     };
2135                     $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2136                 }
2137                 elsif ( $3 eq "A" )
2138                 {
2139                     #$log->debug("ADDED    $4");
2140                     $head->{$4} = {
2141                         name => $4,
2142                         revision => 1,
2143                         filehash => $2,
2144                         commithash => $commit->{hash},
2145                         modified => $commit->{date},
2146                         author => $commit->{author},
2147                         mode => $git_perms,
2148                     };
2149                     $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2150                 }
2151                 else
2152                 {
2153                     $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2154                     die;
2155                 }
2156             }
2157             close FILELIST;
2158         } else {
2159             # this is used to detect files removed from the repo
2160             my $seen_files = {};
2161
2162             my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2163             while ( <FILELIST> )
2164             {
2165                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2166                 {
2167                     die("Couldn't process git-ls-tree line : $_");
2168                 }
2169
2170                 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2171
2172                 $seen_files->{$git_filename} = 1;
2173
2174                 my ( $oldhash, $oldrevision, $oldmode ) = (
2175                     $head->{$git_filename}{filehash},
2176                     $head->{$git_filename}{revision},
2177                     $head->{$git_filename}{mode}
2178                 );
2179
2180                 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2181                 {
2182                     $git_perms = "";
2183                     $git_perms .= "r" if ( $1 & 4 );
2184                     $git_perms .= "w" if ( $1 & 2 );
2185                     $git_perms .= "x" if ( $1 & 1 );
2186                 } else {
2187                     $git_perms = "rw";
2188                 }
2189
2190                 # unless the file exists with the same hash, we need to update it ...
2191                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2192                 {
2193                     my $newrevision = ( $oldrevision or 0 ) + 1;
2194
2195                     $head->{$git_filename} = {
2196                         name => $git_filename,
2197                         revision => $newrevision,
2198                         filehash => $git_hash,
2199                         commithash => $commit->{hash},
2200                         modified => $commit->{date},
2201                         author => $commit->{author},
2202                         mode => $git_perms,
2203                     };
2204
2205
2206                     $db_insert_rev->execute($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2207                 }
2208             }
2209             close FILELIST;
2210
2211             # Detect deleted files
2212             foreach my $file ( keys %$head )
2213             {
2214                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2215                 {
2216                     $head->{$file}{revision}++;
2217                     $head->{$file}{filehash} = "deleted";
2218                     $head->{$file}{commithash} = $commit->{hash};
2219                     $head->{$file}{modified} = $commit->{date};
2220                     $head->{$file}{author} = $commit->{author};
2221
2222                     $db_insert_rev->execute($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2223                 }
2224             }
2225             # END : "Detect deleted files"
2226         }
2227
2228
2229         if (exists $commit->{mergemsg})
2230         {
2231             $db_insert_mergelog->execute($commit->{hash}, $commit->{mergemsg});
2232         }
2233
2234         $lastpicked = $commit->{hash};
2235
2236         $self->_set_prop("last_commit", $commit->{hash});
2237     }
2238
2239     $db_delete_head->execute();
2240     foreach my $file ( keys %$head )
2241     {
2242         $db_insert_head->execute(
2243             $file,
2244             $head->{$file}{revision},
2245             $head->{$file}{filehash},
2246             $head->{$file}{commithash},
2247             $head->{$file}{modified},
2248             $head->{$file}{author},
2249             $head->{$file}{mode},
2250         );
2251     }
2252     # invalidate the gethead cache
2253     $self->{gethead_cache} = undef;
2254
2255
2256     # Ending exclusive lock here
2257     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2258 }
2259
2260 sub _headrev
2261 {
2262     my $self = shift;
2263     my $filename = shift;
2264
2265     my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2266     $db_query->execute($filename);
2267     my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2268
2269     return ( $hash, $revision, $mode );
2270 }
2271
2272 sub _get_prop
2273 {
2274     my $self = shift;
2275     my $key = shift;
2276
2277     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2278     $db_query->execute($key);
2279     my ( $value ) = $db_query->fetchrow_array;
2280
2281     return $value;
2282 }
2283
2284 sub _set_prop
2285 {
2286     my $self = shift;
2287     my $key = shift;
2288     my $value = shift;
2289
2290     my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2291     $db_query->execute($value, $key);
2292
2293     unless ( $db_query->rows )
2294     {
2295         $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2296         $db_query->execute($key, $value);
2297     }
2298
2299     return $value;
2300 }
2301
2302 =head2 gethead
2303
2304 =cut
2305
2306 sub gethead
2307 {
2308     my $self = shift;
2309
2310     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2311
2312     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head",{},1);
2313     $db_query->execute();
2314
2315     my $tree = [];
2316     while ( my $file = $db_query->fetchrow_hashref )
2317     {
2318         push @$tree, $file;
2319     }
2320
2321     $self->{gethead_cache} = $tree;
2322
2323     return $tree;
2324 }
2325
2326 =head2 getlog
2327
2328 =cut
2329
2330 sub getlog
2331 {
2332     my $self = shift;
2333     my $filename = shift;
2334
2335     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2336     $db_query->execute($filename);
2337
2338     my $tree = [];
2339     while ( my $file = $db_query->fetchrow_hashref )
2340     {
2341         push @$tree, $file;
2342     }
2343
2344     return $tree;
2345 }
2346
2347 =head2 getmeta
2348
2349 This function takes a filename (with path) argument and returns a hashref of
2350 metadata for that file.
2351
2352 =cut
2353
2354 sub getmeta
2355 {
2356     my $self = shift;
2357     my $filename = shift;
2358     my $revision = shift;
2359
2360     my $db_query;
2361     if ( defined($revision) and $revision =~ /^\d+$/ )
2362     {
2363         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2364         $db_query->execute($filename, $revision);
2365     }
2366     elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2367     {
2368         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2369         $db_query->execute($filename, $revision);
2370     } else {
2371         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2372         $db_query->execute($filename);
2373     }
2374
2375     return $db_query->fetchrow_hashref;
2376 }
2377
2378 =head2 commitmessage
2379
2380 this function takes a commithash and returns the commit message for that commit
2381
2382 =cut
2383 sub commitmessage
2384 {
2385     my $self = shift;
2386     my $commithash = shift;
2387
2388     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2389
2390     my $db_query;
2391     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2392     $db_query->execute($commithash);
2393
2394     my ( $message ) = $db_query->fetchrow_array;
2395
2396     if ( defined ( $message ) )
2397     {
2398         $message .= " " if ( $message =~ /\n$/ );
2399         return $message;
2400     }
2401
2402     my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2403     shift @lines while ( $lines[0] =~ /\S/ );
2404     $message = join("",@lines);
2405     $message .= " " if ( $message =~ /\n$/ );
2406     return $message;
2407 }
2408
2409 =head2 gethistory
2410
2411 This function takes a filename (with path) argument and returns an arrayofarrays
2412 containing revision,filehash,commithash ordered by revision descending
2413
2414 =cut
2415 sub gethistory
2416 {
2417     my $self = shift;
2418     my $filename = shift;
2419
2420     my $db_query;
2421     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2422     $db_query->execute($filename);
2423
2424     return $db_query->fetchall_arrayref;
2425 }
2426
2427 =head2 gethistorydense
2428
2429 This function takes a filename (with path) argument and returns an arrayofarrays
2430 containing revision,filehash,commithash ordered by revision descending.
2431
2432 This version of gethistory skips deleted entries -- so it is useful for annotate.
2433 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2434 and other git tools that depend on it.
2435
2436 =cut
2437 sub gethistorydense
2438 {
2439     my $self = shift;
2440     my $filename = shift;
2441
2442     my $db_query;
2443     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2444     $db_query->execute($filename);
2445
2446     return $db_query->fetchall_arrayref;
2447 }
2448
2449 =head2 in_array()
2450
2451 from Array::PAT - mimics the in_array() function
2452 found in PHP. Yuck but works for small arrays.
2453
2454 =cut
2455 sub in_array
2456 {
2457     my ($check, @array) = @_;
2458     my $retval = 0;
2459     foreach my $test (@array){
2460         if($check eq $test){
2461             $retval =  1;
2462         }
2463     }
2464     return $retval;
2465 }
2466
2467 =head2 safe_pipe_capture
2468
2469 an alterative to `command` that allows input to be passed as an array
2470 to work around shell problems with weird characters in arguments
2471
2472 =cut
2473 sub safe_pipe_capture {
2474
2475     my @output;
2476
2477     if (my $pid = open my $child, '-|') {
2478         @output = (<$child>);
2479         close $child or die join(' ',@_).": $! $?";
2480     } else {
2481         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2482     }
2483     return wantarray ? @output : join('',@output);
2484 }
2485
2486
2487 1;