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