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