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.
8 #### Copyright The Open University UK - 2006.
10 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
11 #### Martin Langhoff <martin@catalyst.net.nz>
14 #### Released under the GNU Public License, version 2.
23 use File
::Temp qw
/tempdir tempfile/;
24 use File
::Path qw
/rmtree/;
26 use Getopt
::Long
qw(:config require_order no_ignore_case);
28 my $VERSION = '@@GIT_VERSION@@';
30 my $log = GITCVS
::log->new();
48 # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
51 #### Definition and mappings of functions ####
55 'Valid-responses' => \
&req_Validresponses
,
56 'valid-requests' => \
&req_validrequests
,
57 'Directory' => \
&req_Directory
,
58 'Entry' => \
&req_Entry
,
59 'Modified' => \
&req_Modified
,
60 'Unchanged' => \
&req_Unchanged
,
61 'Questionable' => \
&req_Questionable
,
62 'Argument' => \
&req_Argument
,
63 'Argumentx' => \
&req_Argument
,
64 'expand-modules' => \
&req_expandmodules
,
66 'remove' => \
&req_remove
,
68 'update' => \
&req_update
,
73 'tag' => \
&req_CATCHALL
,
74 'status' => \
&req_status
,
75 'admin' => \
&req_CATCHALL
,
76 'history' => \
&req_CATCHALL
,
77 'watchers' => \
&req_EMPTY
,
78 'editors' => \
&req_EMPTY
,
79 'annotate' => \
&req_annotate
,
80 'Global_option' => \
&req_Globaloption
,
81 #'annotate' => \&req_CATCHALL,
84 ##############################################
87 # $state holds all the bits of information the clients sends us that could
88 # potentially be useful when it comes to actually _doing_ something.
89 my $state = { prependdir
=> '' };
91 # Work is for managing temporary working directory
94 state => undef, # undef, 1 (empty), 2 (with stuff)
101 $log->info("--------------- STARTING -----------------");
104 "Usage: git-cvsserver [options] [pserver|server] [<directory> ...]\n".
105 " --base-path <path> : Prepend to requested CVSROOT\n".
106 " --strict-paths : Don't allow recursing into subdirectories\n".
107 " --export-all : Don't check for gitcvs.enabled in config\n".
108 " --version, -V : Print version information and exit\n".
109 " --help, -h, -H : Print usage information and exit\n".
111 "<directory> ... is a list of allowed directories. If no directories\n".
112 "are given, all are allowed. This is an additional restriction, gitcvs\n".
113 "access still needs to be enabled by the gitcvs.enabled config option.\n";
115 my @opts = ( 'help|h|H', 'version|V',
116 'base-path=s', 'strict-paths', 'export-all' );
117 GetOptions
( $state, @opts )
120 if ($state->{version
}) {
121 print "git-cvsserver version $VERSION\n";
124 if ($state->{help
}) {
129 my $TEMP_DIR = tempdir
( CLEANUP
=> 1 );
130 $log->debug("Temporary directory is '$TEMP_DIR'");
132 $state->{method
} = 'ext';
134 if ($ARGV[0] eq 'pserver') {
135 $state->{method
} = 'pserver';
137 } elsif ($ARGV[0] eq 'server') {
142 # everything else is a directory
143 $state->{allowed_roots
} = [ @ARGV ];
145 # don't export the whole system unless the users requests it
146 if ($state->{'export-all'} && !@
{$state->{allowed_roots
}}) {
147 die "--export-all can only be used together with an explicit whitelist\n";
150 # if we are called with a pserver argument,
151 # deal with the authentication cat before entering the
153 if ($state->{method
} eq 'pserver') {
154 my $line = <STDIN
>; chomp $line;
155 unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
156 die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
159 $line = <STDIN
>; chomp $line;
160 unless (req_Root
('root', $line)) { # reuse Root
161 print "E Invalid root $line \n";
164 $line = <STDIN
>; chomp $line;
165 unless ($line eq 'anonymous') {
166 print "E Only anonymous user allowed via pserver\n";
167 print "I HATE YOU\n";
170 $line = <STDIN
>; chomp $line; # validate the password?
171 $line = <STDIN
>; chomp $line;
172 unless ($line eq "END $request REQUEST") {
173 die "E Do not understand $line -- expecting END $request REQUEST\n";
175 print "I LOVE YOU\n";
176 exit if $request eq 'VERIFICATION'; # cvs login
177 # and now back to our regular programme...
180 # Keep going until the client closes the connection
185 # Check to see if we've seen this method, and call appropriate function.
186 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
188 # use the $methods hash to call the appropriate sub for this command
189 #$log->info("Method : $1");
190 &{$methods->{$1}}($1,$2);
192 # log fatal because we don't understand this function. If this happens
193 # we're fairly screwed because we don't know if the client is expecting
194 # a response. If it is, the client will hang, we'll hang, and the whole
195 # thing will be custard.
196 $log->fatal("Don't understand command $_\n");
197 die("Unknown command $_");
201 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
202 $log->info("--------------- FINISH -----------------");
207 # Magic catchall method.
208 # This is the method that will handle all commands we haven't yet
209 # implemented. It simply sends a warning to the log file indicating a
210 # command that hasn't been implemented has been invoked.
213 my ( $cmd, $data ) = @_;
214 $log->warn("Unhandled command : req_$cmd : $data");
217 # This method invariably succeeds with an empty response.
224 # Response expected: no. Tell the server which CVSROOT to use. Note that
225 # pathname is a local directory and not a fully qualified CVSROOT variable.
226 # pathname must already exist; if creating a new root, use the init
227 # request, not Root. pathname does not include the hostname of the server,
228 # how to access the server, etc.; by the time the CVS protocol is in use,
229 # connection, authentication, etc., are already taken care of. The Root
230 # request must be sent only once, and it must be sent before any requests
231 # other than Valid-responses, valid-requests, UseUnchanged, Set or init.
234 my ( $cmd, $data ) = @_;
235 $log->debug("req_Root : $data");
237 unless ($data =~ m
#^/#) {
238 print "error 1 Root must be an absolute pathname\n";
242 my $cvsroot = $state->{'base-path'} || '';
246 if ($state->{CVSROOT
}
247 && ($state->{CVSROOT
} ne $cvsroot)) {
248 print "error 1 Conflicting roots specified\n";
252 $state->{CVSROOT
} = $cvsroot;
254 $ENV{GIT_DIR
} = $state->{CVSROOT
} . "/";
256 if (@
{$state->{allowed_roots
}}) {
258 foreach my $dir (@
{$state->{allowed_roots
}}) {
259 next unless $dir =~ m
#^/#;
261 if ($state->{'strict-paths'}) {
262 if ($ENV{GIT_DIR
} =~ m
#^\Q$dir\E/?$#) {
266 } elsif ($ENV{GIT_DIR
} =~ m
#^\Q$dir\E(/?$|/)#) {
273 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
275 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
280 unless (-d
$ENV{GIT_DIR
} && -e
$ENV{GIT_DIR
}.'HEAD') {
281 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
283 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
287 my @gitvars = `git-config -l`;
289 print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
291 print "error 1 - problem executing git-config\n";
294 foreach my $line ( @gitvars )
296 next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
300 $cfg->{$1}{$2}{$3} = $4;
304 my $enabled = ($cfg->{gitcvs
}{$state->{method
}}{enabled
}
305 || $cfg->{gitcvs
}{enabled
});
306 unless ($state->{'export-all'} ||
307 ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
308 print "E GITCVS emulation needs to be enabled on this repo\n";
309 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
311 print "error 1 GITCVS emulation disabled\n";
315 my $logfile = $cfg->{gitcvs
}{$state->{method
}}{logfile
} || $cfg->{gitcvs
}{logfile
};
318 $log->setfile($logfile);
326 # Global_option option \n
327 # Response expected: no. Transmit one of the global options `-q', `-Q',
328 # `-l', `-t', `-r', or `-n'. option must be one of those strings, no
329 # variations (such as combining of options) are allowed. For graceful
330 # handling of valid-requests, it is probably better to make new global
331 # options separate requests, rather than trying to add them to this
335 my ( $cmd, $data ) = @_;
336 $log->debug("req_Globaloption : $data");
337 $state->{globaloptions
}{$data} = 1;
340 # Valid-responses request-list \n
341 # Response expected: no. Tell the server what responses the client will
342 # accept. request-list is a space separated list of tokens.
343 sub req_Validresponses
345 my ( $cmd, $data ) = @_;
346 $log->debug("req_Validresponses : $data");
348 # TODO : re-enable this, currently it's not particularly useful
349 #$state->{validresponses} = [ split /\s+/, $data ];
353 # Response expected: yes. Ask the server to send back a Valid-requests
355 sub req_validrequests
357 my ( $cmd, $data ) = @_;
359 $log->debug("req_validrequests");
361 $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
362 $log->debug("SEND : ok");
364 print "Valid-requests " . join(" ",keys %$methods) . "\n";
368 # Directory local-directory \n
369 # Additional data: repository \n. Response expected: no. Tell the server
370 # what directory to use. The repository should be a directory name from a
371 # previous server response. Note that this both gives a default for Entry
372 # and Modified and also for ci and the other commands; normal usage is to
373 # send Directory for each directory in which there will be an Entry or
374 # Modified, and then a final Directory for the original directory, then the
375 # command. The local-directory is relative to the top level at which the
376 # command is occurring (i.e. the last Directory which is sent before the
377 # command); to indicate that top level, `.' should be sent for
381 my ( $cmd, $data ) = @_;
383 my $repository = <STDIN
>;
387 $state->{localdir
} = $data;
388 $state->{repository
} = $repository;
389 $state->{path
} = $repository;
390 $state->{path
} =~ s/^$state->{CVSROOT}\///;
391 $state->{module
} = $1 if ($state->{path
} =~ s/^(.*?)(\/|$)//);
392 $state->{path
} .= "/" if ( $state->{path
} =~ /\S
/ );
394 $state->{directory
} = $state->{localdir
};
395 $state->{directory
} = "" if ( $state->{directory
} eq "." );
396 $state->{directory
} .= "/" if ( $state->{directory
} =~ /\S
/ );
398 if ( (not defined($state->{prependdir
}) or $state->{prependdir
} eq '') and $state->{localdir
} eq "." and $state->{path
} =~ /\S/ )
400 $log->info("Setting prepend to '$state->{path}'");
401 $state->{prependdir
} = $state->{path
};
402 foreach my $entry ( keys %{$state->{entries
}} )
404 $state->{entries
}{$state->{prependdir
} . $entry} = $state->{entries
}{$entry};
405 delete $state->{entries
}{$entry};
409 if ( defined ( $state->{prependdir
} ) )
411 $log->debug("Prepending '$state->{prependdir}' to state|directory");
412 $state->{directory
} = $state->{prependdir
} . $state->{directory
}
414 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
417 # Entry entry-line \n
418 # Response expected: no. Tell the server what version of a file is on the
419 # local machine. The name in entry-line is a name relative to the directory
420 # most recently specified with Directory. If the user is operating on only
421 # some files in a directory, Entry requests for only those files need be
422 # included. If an Entry request is sent without Modified, Is-modified, or
423 # Unchanged, it means the file is lost (does not exist in the working
424 # directory). If both Entry and one of Modified, Is-modified, or Unchanged
425 # are sent for the same file, Entry must be sent first. For a given file,
426 # one can send Modified, Is-modified, or Unchanged, but not more than one
430 my ( $cmd, $data ) = @_;
432 #$log->debug("req_Entry : $data");
434 my @data = split(/\//, $data);
436 $state->{entries
}{$state->{directory
}.$data[1]} = {
437 revision
=> $data[2],
438 conflict
=> $data[3],
440 tag_or_date
=> $data[5],
443 $log->info("Received entry line '$data' => '" . $state->{directory
} . $data[1] . "'");
446 # Questionable filename \n
447 # Response expected: no. Additional data: no. Tell the server to check
448 # whether filename should be ignored, and if not, next time the server
449 # sends responses, send (in a M response) `?' followed by the directory and
450 # filename. filename must not contain `/'; it needs to be a file in the
451 # directory named by the most recent Directory request.
454 my ( $cmd, $data ) = @_;
456 $log->debug("req_Questionable : $data");
457 $state->{entries
}{$state->{directory
}.$data}{questionable
} = 1;
461 # Response expected: yes. Add a file or directory. This uses any previous
462 # Argument, Directory, Entry, or Modified requests, if they have been sent.
463 # The last Directory sent specifies the working directory at the time of
464 # the operation. To add a directory, send the directory to be added using
465 # Directory and Argument requests.
468 my ( $cmd, $data ) = @_;
472 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
475 argsfromdir
($updater);
479 foreach my $filename ( @
{$state->{args
}} )
481 $filename = filecleanup
($filename);
483 my $meta = $updater->getmeta($filename);
484 my $wrev = revparse
($filename);
486 if ($wrev && $meta && ($wrev < 0))
488 # previously removed file, add back
489 $log->info("added file $filename was previously removed, send 1.$meta->{revision}");
491 print "MT +updated\n";
492 print "MT text U \n";
493 print "MT fname $filename\n";
494 print "MT newline\n";
495 print "MT -updated\n";
497 unless ( $state->{globaloptions
}{-n
} )
499 my ( $filepart, $dirpart ) = filenamesplit
($filename,1);
501 print "Created $dirpart\n";
502 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
504 # this is an "entries" line
505 my $kopts = kopts_from_path
($filepart);
506 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
507 print "/$filepart/1.$meta->{revision}//$kopts/\n";
509 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
510 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
512 transmitfile
($meta->{filehash
});
518 unless ( defined ( $state->{entries
}{$filename}{modified_filename
} ) )
520 print "E cvs add: nothing known about `$filename'\n";
523 # TODO : check we're not squashing an already existing file
524 if ( defined ( $state->{entries
}{$filename}{revision
} ) )
526 print "E cvs add: `$filename' has already been entered\n";
530 my ( $filepart, $dirpart ) = filenamesplit
($filename, 1);
532 print "E cvs add: scheduling file `$filename' for addition\n";
534 print "Checked-in $dirpart\n";
536 my $kopts = kopts_from_path
($filepart);
537 print "/$filepart/0//$kopts/\n";
542 if ( $addcount == 1 )
544 print "E cvs add: use `cvs commit' to add this file permanently\n";
546 elsif ( $addcount > 1 )
548 print "E cvs add: use `cvs commit' to add these files permanently\n";
555 # Response expected: yes. Remove a file. This uses any previous Argument,
556 # Directory, Entry, or Modified requests, if they have been sent. The last
557 # Directory sent specifies the working directory at the time of the
558 # operation. Note that this request does not actually do anything to the
559 # repository; the only effect of a successful remove request is to supply
560 # the client with a new entries line containing `-' to indicate a removed
561 # file. In fact, the client probably could perform this operation without
562 # contacting the server, although using remove may cause the server to
563 # perform a few more checks. The client sends a subsequent ci request to
564 # actually record the removal in the repository.
567 my ( $cmd, $data ) = @_;
571 # Grab a handle to the SQLite db and do any necessary updates
572 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
575 #$log->debug("add state : " . Dumper($state));
579 foreach my $filename ( @
{$state->{args
}} )
581 $filename = filecleanup
($filename);
583 if ( defined ( $state->{entries
}{$filename}{unchanged
} ) or defined ( $state->{entries
}{$filename}{modified_filename
} ) )
585 print "E cvs remove: file `$filename' still in working directory\n";
589 my $meta = $updater->getmeta($filename);
590 my $wrev = revparse
($filename);
592 unless ( defined ( $wrev ) )
594 print "E cvs remove: nothing known about `$filename'\n";
598 if ( defined($wrev) and $wrev < 0 )
600 print "E cvs remove: file `$filename' already scheduled for removal\n";
604 unless ( $wrev == $meta->{revision
} )
606 # TODO : not sure if the format of this message is quite correct.
607 print "E cvs remove: Up to date check failed for `$filename'\n";
612 my ( $filepart, $dirpart ) = filenamesplit
($filename, 1);
614 print "E cvs remove: scheduling `$filename' for removal\n";
616 print "Checked-in $dirpart\n";
618 my $kopts = kopts_from_path
($filepart);
619 print "/$filepart/-1.$wrev//$kopts/\n";
626 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
628 elsif ( $rmcount > 1 )
630 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
636 # Modified filename \n
637 # Response expected: no. Additional data: mode, \n, file transmission. Send
638 # the server a copy of one locally modified file. filename is a file within
639 # the most recent directory sent with Directory; it must not contain `/'.
640 # If the user is operating on only some files in a directory, only those
641 # files need to be included. This can also be sent without Entry, if there
642 # is no entry for the file.
645 my ( $cmd, $data ) = @_;
649 or (print "E end of file reading mode for $data\n"), return;
653 or (print "E end of file reading size of $data\n"), return;
656 # Grab config information
657 my $blocksize = 8192;
658 my $bytesleft = $size;
661 # Get a filehandle/name to write it to
662 my ( $fh, $filename ) = tempfile
( DIR
=> $TEMP_DIR );
664 # Loop over file data writing out to temporary file.
667 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
668 read STDIN
, $tmp, $blocksize;
670 $bytesleft -= $blocksize;
674 or (print "E failed to write temporary, $filename: $!\n"), return;
676 # Ensure we have something sensible for the file mode
677 if ( $mode =~ /u=(\w+)/ )
684 # Save the file data in $state
685 $state->{entries
}{$state->{directory
}.$data}{modified_filename
} = $filename;
686 $state->{entries
}{$state->{directory
}.$data}{modified_mode
} = $mode;
687 $state->{entries
}{$state->{directory
}.$data}{modified_hash
} = `git-hash-object $filename`;
688 $state->{entries
}{$state->{directory
}.$data}{modified_hash
} =~ s/\s.*$//s;
690 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
693 # Unchanged filename \n
694 # Response expected: no. Tell the server that filename has not been
695 # modified in the checked out directory. The filename is a file within the
696 # most recent directory sent with Directory; it must not contain `/'.
699 my ( $cmd, $data ) = @_;
701 $state->{entries
}{$state->{directory
}.$data}{unchanged
} = 1;
703 #$log->debug("req_Unchanged : $data");
707 # Response expected: no. Save argument for use in a subsequent command.
708 # Arguments accumulate until an argument-using command is given, at which
709 # point they are forgotten.
711 # Response expected: no. Append \n followed by text to the current argument
715 my ( $cmd, $data ) = @_;
717 # Argumentx means: append to last Argument (with a newline in front)
719 $log->debug("$cmd : $data");
721 if ( $cmd eq 'Argumentx') {
722 ${$state->{arguments
}}[$#{$state->{arguments}}] .= "\n" . $data;
724 push @
{$state->{arguments
}}, $data;
729 # Response expected: yes. Expand the modules which are specified in the
730 # arguments. Returns the data in Module-expansion responses. Note that the
731 # server can assume that this is checkout or export, not rtag or rdiff; the
732 # latter do not access the working directory and thus have no need to
733 # expand modules on the client side. Expand may not be the best word for
734 # what this request does. It does not necessarily tell you all the files
735 # contained in a module, for example. Basically it is a way of telling you
736 # which working directories the server needs to know about in order to
737 # handle a checkout of the specified modules. For example, suppose that the
738 # server has a module defined by
739 # aliasmodule -a 1dir
740 # That is, one can check out aliasmodule and it will take 1dir in the
741 # repository and check it out to 1dir in the working directory. Now suppose
742 # the client already has this module checked out and is planning on using
743 # the co request to update it. Without using expand-modules, the client
744 # would have two bad choices: it could either send information about all
745 # working directories under the current directory, which could be
746 # unnecessarily slow, or it could be ignorant of the fact that aliasmodule
747 # stands for 1dir, and neglect to send information for 1dir, which would
748 # lead to incorrect operation. With expand-modules, the client would first
749 # ask for the module to be expanded:
750 sub req_expandmodules
752 my ( $cmd, $data ) = @_;
756 $log->debug("req_expandmodules : " . ( defined($data) ?
$data : "[NULL]" ) );
758 unless ( ref $state->{arguments
} eq "ARRAY" )
764 foreach my $module ( @
{$state->{arguments
}} )
766 $log->debug("SEND : Module-expansion $module");
767 print "Module-expansion $module\n";
775 # Response expected: yes. Get files from the repository. This uses any
776 # previous Argument, Directory, Entry, or Modified requests, if they have
777 # been sent. Arguments to this command are module names; the client cannot
778 # know what directories they correspond to except by (1) just sending the
779 # co request, and then seeing what directory names the server sends back in
780 # its responses, and (2) the expand-modules request.
783 my ( $cmd, $data ) = @_;
787 my $module = $state->{args
}[0];
788 my $checkout_path = $module;
790 # use the user specified directory if we're given it
791 $checkout_path = $state->{opt
}{d
} if ( exists ( $state->{opt
}{d
} ) );
793 $log->debug("req_co : " . ( defined($data) ?
$data : "[NULL]" ) );
795 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
797 $ENV{GIT_DIR
} = $state->{CVSROOT
} . "/";
799 # Grab a handle to the SQLite db and do any necessary updates
800 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $module, $log);
803 $checkout_path =~ s
|/$||; # get rid of trailing slashes
805 # Eclipse seems to need the Clear-sticky command
806 # to prepare the 'Entries' file for the new directory.
807 print "Clear-sticky $checkout_path/\n";
808 print $state->{CVSROOT
} . "/$module/\n";
809 print "Clear-static-directory $checkout_path/\n";
810 print $state->{CVSROOT
} . "/$module/\n";
811 print "Clear-sticky $checkout_path/\n"; # yes, twice
812 print $state->{CVSROOT
} . "/$module/\n";
813 print "Template $checkout_path/\n";
814 print $state->{CVSROOT
} . "/$module/\n";
817 # instruct the client that we're checking out to $checkout_path
818 print "E cvs checkout: Updating $checkout_path\n";
825 my ($dir, $repodir, $remotedir, $seendirs) = @_;
826 my $parent = dirname
($dir);
829 $remotedir =~ s
|/+$||;
831 $log->debug("announcedir $dir, $repodir, $remotedir" );
833 if ($parent eq '.' || $parent eq './') {
836 # recurse to announce unseen parents first
837 if (length($parent) && !exists($seendirs->{$parent})) {
838 prepdir
($parent, $repodir, $remotedir, $seendirs);
840 # Announce that we are going to modify at the parent level
842 print "E cvs checkout: Updating $remotedir/$parent\n";
844 print "E cvs checkout: Updating $remotedir\n";
846 print "Clear-sticky $remotedir/$parent/\n";
847 print "$repodir/$parent/\n";
849 print "Clear-static-directory $remotedir/$dir/\n";
850 print "$repodir/$dir/\n";
851 print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
852 print "$repodir/$parent/\n";
853 print "Template $remotedir/$dir/\n";
854 print "$repodir/$dir/\n";
857 $seendirs->{$dir} = 1;
860 foreach my $git ( @
{$updater->gethead} )
862 # Don't want to check out deleted files
863 next if ( $git->{filehash
} eq "deleted" );
865 ( $git->{name
}, $git->{dir
} ) = filenamesplit
($git->{name
});
867 if (length($git->{dir
}) && $git->{dir
} ne './'
868 && $git->{dir
} ne $lastdir ) {
869 unless (exists($seendirs{$git->{dir
}})) {
870 prepdir
($git->{dir
}, $state->{CVSROOT
} . "/$module/",
871 $checkout_path, \
%seendirs);
872 $lastdir = $git->{dir
};
873 $seendirs{$git->{dir
}} = 1;
875 print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
878 # modification time of this file
879 print "Mod-time $git->{modified}\n";
881 # print some information to the client
882 if ( defined ( $git->{dir
} ) and $git->{dir
} ne "./" )
884 print "M U $checkout_path/$git->{dir}$git->{name}\n";
886 print "M U $checkout_path/$git->{name}\n";
889 # instruct client we're sending a file to put in this path
890 print "Created $checkout_path/" . ( defined ( $git->{dir
} ) and $git->{dir
} ne "./" ?
$git->{dir
} . "/" : "" ) . "\n";
892 print $state->{CVSROOT
} . "/$module/" . ( defined ( $git->{dir
} ) and $git->{dir
} ne "./" ?
$git->{dir
} . "/" : "" ) . "$git->{name}\n";
894 # this is an "entries" line
895 my $kopts = kopts_from_path
($git->{name
});
896 print "/$git->{name}/1.$git->{revision}//$kopts/\n";
898 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
901 transmitfile
($git->{filehash
});
910 # Response expected: yes. Actually do a cvs update command. This uses any
911 # previous Argument, Directory, Entry, or Modified requests, if they have
912 # been sent. The last Directory sent specifies the working directory at the
913 # time of the operation. The -I option is not used--files which the client
914 # can decide whether to ignore are not mentioned and the client sends the
915 # Questionable request for others.
918 my ( $cmd, $data ) = @_;
920 $log->debug("req_update : " . ( defined($data) ?
$data : "[NULL]" ));
925 # It may just be a client exploring the available heads/modules
926 # in that case, list them as top level directories and leave it
927 # at that. Eclipse uses this technique to offer you a list of
928 # projects (heads in this case) to checkout.
930 if ($state->{module
} eq '') {
931 my $heads_dir = $state->{CVSROOT
} . '/refs/heads';
932 if (!opendir HEADS
, $heads_dir) {
933 print "E [server aborted]: Failed to open directory, "
934 . "$heads_dir: $!\nerror\n";
937 print "E cvs update: Updating .\n";
938 while (my $head = readdir(HEADS
)) {
939 if (-f
$state->{CVSROOT
} . '/refs/heads/' . $head) {
940 print "E cvs update: New directory `$head'\n";
949 # Grab a handle to the SQLite db and do any necessary updates
950 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
954 argsfromdir
($updater);
956 #$log->debug("update state : " . Dumper($state));
958 # foreach file specified on the command line ...
959 foreach my $filename ( @
{$state->{args
}} )
961 $filename = filecleanup
($filename);
963 $log->debug("Processing file $filename");
965 # if we have a -C we should pretend we never saw modified stuff
966 if ( exists ( $state->{opt
}{C
} ) )
968 delete $state->{entries
}{$filename}{modified_hash
};
969 delete $state->{entries
}{$filename}{modified_filename
};
970 $state->{entries
}{$filename}{unchanged
} = 1;
974 if ( defined($state->{opt
}{r
}) and $state->{opt
}{r
} =~ /^1\.(\d+)/ )
976 $meta = $updater->getmeta($filename, $1);
978 $meta = $updater->getmeta($filename);
981 # If -p was given, "print" the contents of the requested revision.
982 if ( exists ( $state->{opt
}{p
} ) ) {
983 if ( defined ( $meta->{revision
} ) ) {
984 $log->info("Printing '$filename' revision " . $meta->{revision
});
986 transmitfile
($meta->{filehash
}, { print => 1 });
992 if ( ! defined $meta )
1001 my $oldmeta = $meta;
1003 my $wrev = revparse
($filename);
1005 # If the working copy is an old revision, lets get that version too for comparison.
1006 if ( defined($wrev) and $wrev != $meta->{revision
} )
1008 $oldmeta = $updater->getmeta($filename, $wrev);
1011 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1013 # Files are up to date if the working copy and repo copy have the same revision,
1014 # and the working copy is unmodified _and_ the user hasn't specified -C
1015 next if ( defined ( $wrev )
1016 and defined($meta->{revision
})
1017 and $wrev == $meta->{revision
}
1018 and $state->{entries
}{$filename}{unchanged
}
1019 and not exists ( $state->{opt
}{C
} ) );
1021 # If the working copy and repo copy have the same revision,
1022 # but the working copy is modified, tell the client it's modified
1023 if ( defined ( $wrev )
1024 and defined($meta->{revision
})
1025 and $wrev == $meta->{revision
}
1026 and defined($state->{entries
}{$filename}{modified_hash
})
1027 and not exists ( $state->{opt
}{C
} ) )
1029 $log->info("Tell the client the file is modified");
1030 print "MT text M \n";
1031 print "MT fname $filename\n";
1032 print "MT newline\n";
1036 if ( $meta->{filehash
} eq "deleted" )
1038 my ( $filepart, $dirpart ) = filenamesplit
($filename,1);
1040 $log->info("Removing '$filename' from working copy (no longer in the repo)");
1042 print "E cvs update: `$filename' is no longer in the repository\n";
1043 # Don't want to actually _DO_ the update if -n specified
1044 unless ( $state->{globaloptions
}{-n
} ) {
1045 print "Removed $dirpart\n";
1046 print "$filepart\n";
1049 elsif ( not defined ( $state->{entries
}{$filename}{modified_hash
} )
1050 or $state->{entries
}{$filename}{modified_hash
} eq $oldmeta->{filehash
}
1051 or $meta->{filehash
} eq 'added' )
1053 # normal update, just send the new revision (either U=Update,
1054 # or A=Add, or R=Remove)
1055 if ( defined($wrev) && $wrev < 0 )
1057 $log->info("Tell the client the file is scheduled for removal");
1058 print "MT text R \n";
1059 print "MT fname $filename\n";
1060 print "MT newline\n";
1063 elsif ( (!defined($wrev) || $wrev == 0) && (!defined($meta->{revision
}) || $meta->{revision
} == 0) )
1065 $log->info("Tell the client the file is scheduled for addition");
1066 print "MT text A \n";
1067 print "MT fname $filename\n";
1068 print "MT newline\n";
1073 $log->info("Updating '$filename' to ".$meta->{revision
});
1074 print "MT +updated\n";
1075 print "MT text U \n";
1076 print "MT fname $filename\n";
1077 print "MT newline\n";
1078 print "MT -updated\n";
1081 my ( $filepart, $dirpart ) = filenamesplit
($filename,1);
1083 # Don't want to actually _DO_ the update if -n specified
1084 unless ( $state->{globaloptions
}{-n
} )
1086 if ( defined ( $wrev ) )
1088 # instruct client we're sending a file to put in this path as a replacement
1089 print "Update-existing $dirpart\n";
1090 $log->debug("Updating existing file 'Update-existing $dirpart'");
1092 # instruct client we're sending a file to put in this path as a new file
1093 print "Clear-static-directory $dirpart\n";
1094 print $state->{CVSROOT
} . "/$state->{module}/$dirpart\n";
1095 print "Clear-sticky $dirpart\n";
1096 print $state->{CVSROOT
} . "/$state->{module}/$dirpart\n";
1098 $log->debug("Creating new file 'Created $dirpart'");
1099 print "Created $dirpart\n";
1101 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
1103 # this is an "entries" line
1104 my $kopts = kopts_from_path
($filepart);
1105 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
1106 print "/$filepart/1.$meta->{revision}//$kopts/\n";
1109 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1110 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1113 transmitfile
($meta->{filehash
});
1116 $log->info("Updating '$filename'");
1117 my ( $filepart, $dirpart ) = filenamesplit
($meta->{name
},1);
1119 my $mergeDir = setupTmpDir
();
1121 my $file_local = $filepart . ".mine";
1122 my $mergedFile = "$mergeDir/$file_local";
1123 system("ln","-s",$state->{entries
}{$filename}{modified_filename
}, $file_local);
1124 my $file_old = $filepart . "." . $oldmeta->{revision
};
1125 transmitfile
($oldmeta->{filehash
}, { targetfile
=> $file_old });
1126 my $file_new = $filepart . "." . $meta->{revision
};
1127 transmitfile
($meta->{filehash
}, { targetfile
=> $file_new });
1129 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1130 $log->info("Merging $file_local, $file_old, $file_new");
1131 print "M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into $filename\n";
1133 $log->debug("Temporary directory for merge is $mergeDir");
1135 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
1142 $log->info("Merged successfully");
1143 print "M M $filename\n";
1144 $log->debug("Merged $dirpart");
1146 # Don't want to actually _DO_ the update if -n specified
1147 unless ( $state->{globaloptions
}{-n
} )
1149 print "Merged $dirpart\n";
1150 $log->debug($state->{CVSROOT
} . "/$state->{module}/$filename");
1151 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
1152 my $kopts = kopts_from_path
($filepart);
1153 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
1154 print "/$filepart/1.$meta->{revision}//$kopts/\n";
1157 elsif ( $return == 1 )
1159 $log->info("Merged with conflicts");
1160 print "E cvs update: conflicts found in $filename\n";
1161 print "M C $filename\n";
1163 # Don't want to actually _DO_ the update if -n specified
1164 unless ( $state->{globaloptions
}{-n
} )
1166 print "Merged $dirpart\n";
1167 print $state->{CVSROOT
} . "/$state->{module}/$filename\n";
1168 my $kopts = kopts_from_path
($filepart);
1169 print "/$filepart/1.$meta->{revision}/+/$kopts/\n";
1174 $log->warn("Merge failed");
1178 # Don't want to actually _DO_ the update if -n specified
1179 unless ( $state->{globaloptions
}{-n
} )
1182 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1183 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1185 # transmit file, format is single integer on a line by itself (file
1186 # size) followed by the file contents
1187 # TODO : we should copy files in blocks
1188 my $data = `cat $mergedFile`;
1189 $log->debug("File size : " . length($data));
1190 print length($data) . "\n";
1202 my ( $cmd, $data ) = @_;
1206 #$log->debug("State : " . Dumper($state));
1208 $log->info("req_ci : " . ( defined($data) ?
$data : "[NULL]" ));
1210 if ( $state->{method
} eq 'pserver')
1212 print "error 1 pserver access cannot commit\n";
1217 if ( -e
$state->{CVSROOT
} . "/index" )
1219 $log->warn("file 'index' already exists in the git repository");
1220 print "error 1 Index already exists in git repo\n";
1225 # Grab a handle to the SQLite db and do any necessary updates
1226 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1229 # Remember where the head was at the beginning.
1230 my $parenthash = `git show-ref -s refs/heads/$state->{module}`;
1232 if ($parenthash !~ /^[0-9a-f]{40}$/) {
1233 print "error 1 pserver cannot find the current HEAD of module";
1238 setupWorkTree
($parenthash);
1240 $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
1242 $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
1244 my @committedfiles = ();
1247 # foreach file specified on the command line ...
1248 foreach my $filename ( @
{$state->{args
}} )
1250 my $committedfile = $filename;
1251 $filename = filecleanup
($filename);
1253 next unless ( exists $state->{entries
}{$filename}{modified_filename
} or not $state->{entries
}{$filename}{unchanged
} );
1255 my $meta = $updater->getmeta($filename);
1256 $oldmeta{$filename} = $meta;
1258 my $wrev = revparse
($filename);
1260 my ( $filepart, $dirpart ) = filenamesplit
($filename);
1262 # do a checkout of the file if it is part of this tree
1264 system('git-checkout-index', '-f', '-u', $filename);
1266 die "Error running git-checkout-index -f -u $filename : $!";
1272 $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1273 $addflag = 1 unless ( -e
$filename );
1275 # Do up to date checking
1276 unless ( $addflag or $wrev == $meta->{revision
} or ( $rmflag and -$wrev == $meta->{revision
} ) )
1278 # fail everything if an up to date check fails
1279 print "error 1 Up to date check failed for $filename\n";
1284 push @committedfiles, $committedfile;
1285 $log->info("Committing $filename");
1287 system("mkdir","-p",$dirpart) unless ( -d
$dirpart );
1291 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1292 rename $state->{entries
}{$filename}{modified_filename
},$filename;
1294 # Calculate modes to remove
1296 foreach ( qw
(r w x
) ) { $invmode .= $_ unless ( $state->{entries
}{$filename}{modified_mode
} =~ /$_/ ); }
1298 $log->debug("chmod u+" . $state->{entries
}{$filename}{modified_mode
} . "-" . $invmode . " $filename");
1299 system("chmod","u+" . $state->{entries
}{$filename}{modified_mode
} . "-" . $invmode, $filename);
1304 $log->info("Removing file '$filename'");
1306 system("git-update-index", "--remove", $filename);
1310 $log->info("Adding file '$filename'");
1311 system("git-update-index", "--add", $filename);
1313 $log->info("Updating file '$filename'");
1314 system("git-update-index", $filename);
1318 unless ( scalar(@committedfiles) > 0 )
1320 print "E No files to commit\n";
1326 my $treehash = `git-write-tree`;
1329 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1331 # write our commit message out if we have one ...
1332 my ( $msg_fh, $msg_filename ) = tempfile
( DIR
=> $TEMP_DIR );
1333 print $msg_fh $state->{opt
}{m
};# if ( exists ( $state->{opt}{m} ) );
1334 print $msg_fh "\n\nvia git-CVS emulator\n";
1337 my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1339 $log->info("Commit hash : $commithash");
1341 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1343 $log->warn("Commit failed (Invalid commit hash)");
1344 print "error 1 Commit failed (unknown reason)\n";
1349 ### Emulate git-receive-pack by running hooks/update
1350 my @hook = ( $ENV{GIT_DIR
}.'hooks/update', "refs/heads/$state->{module}",
1351 $parenthash, $commithash );
1353 unless( system( @hook ) == 0 )
1355 $log->warn("Commit failed (update hook declined to update ref)");
1356 print "error 1 Commit failed (update hook declined)\n";
1363 if (system(qw(git update-ref -m), "cvsserver ci",
1364 "refs/heads/$state->{module}", $commithash, $parenthash)) {
1365 $log->warn("update-ref for $state->{module} failed.");
1366 print "error 1 Cannot commit -- update first\n";
1371 ### Emulate git-receive-pack by running hooks/post-receive
1372 my $hook = $ENV{GIT_DIR
}.'hooks/post-receive';
1374 open(my $pipe, "| $hook") || die "can't fork $!";
1376 local $SIG{PIPE
} = sub { die 'pipe broke' };
1378 print $pipe "$parenthash $commithash refs/heads/$state->{module}\n";
1380 close $pipe || die "bad pipe: $! $?";
1383 ### Then hooks/post-update
1384 $hook = $ENV{GIT_DIR
}.'hooks/post-update';
1386 system($hook, "refs/heads/$state->{module}");
1391 # foreach file specified on the command line ...
1392 foreach my $filename ( @committedfiles )
1394 $filename = filecleanup
($filename);
1396 my $meta = $updater->getmeta($filename);
1397 unless (defined $meta->{revision
}) {
1398 $meta->{revision
} = 1;
1401 my ( $filepart, $dirpart ) = filenamesplit
($filename, 1);
1403 $log->debug("Checked-in $dirpart : $filename");
1405 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
1406 if ( defined $meta->{filehash
} && $meta->{filehash
} eq "deleted" )
1408 print "M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";
1409 print "Remove-entry $dirpart\n";
1410 print "$filename\n";
1412 if ($meta->{revision
} == 1) {
1413 print "M initial revision: 1.1\n";
1415 print "M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";
1417 print "Checked-in $dirpart\n";
1418 print "$filename\n";
1419 my $kopts = kopts_from_path
($filepart);
1420 print "/$filepart/1.$meta->{revision}//$kopts/\n";
1430 my ( $cmd, $data ) = @_;
1434 $log->info("req_status : " . ( defined($data) ?
$data : "[NULL]" ));
1435 #$log->debug("status state : " . Dumper($state));
1437 # Grab a handle to the SQLite db and do any necessary updates
1438 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1441 # if no files were specified, we need to work out what files we should be providing status on ...
1442 argsfromdir
($updater);
1444 # foreach file specified on the command line ...
1445 foreach my $filename ( @
{$state->{args
}} )
1447 $filename = filecleanup
($filename);
1449 next if exists($state->{opt
}{l
}) && index($filename, '/', length($state->{prependdir
})) >= 0;
1451 my $meta = $updater->getmeta($filename);
1452 my $oldmeta = $meta;
1454 my $wrev = revparse
($filename);
1456 # If the working copy is an old revision, lets get that version too for comparison.
1457 if ( defined($wrev) and $wrev != $meta->{revision
} )
1459 $oldmeta = $updater->getmeta($filename, $wrev);
1462 # TODO : All possible statuses aren't yet implemented
1464 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1465 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision
}) and $wrev == $meta->{revision
}
1467 ( ( $state->{entries
}{$filename}{unchanged
} and ( not defined ( $state->{entries
}{$filename}{conflict
} ) or $state->{entries
}{$filename}{conflict
} !~ /^\+=/ ) )
1468 or ( defined($state->{entries
}{$filename}{modified_hash
}) and $state->{entries
}{$filename}{modified_hash
} eq $meta->{filehash
} ) )
1471 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1472 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision
} ) and $meta->{revision
} > $wrev
1474 ( $state->{entries
}{$filename}{unchanged
}
1475 or ( defined($state->{entries
}{$filename}{modified_hash
}) and $state->{entries
}{$filename}{modified_hash
} eq $oldmeta->{filehash
} ) )
1478 # Need checkout if it exists in the repo but doesn't have a working copy
1479 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision
} ) );
1481 # Locally modified if working copy and repo copy have the same revision but there are local changes
1482 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision
}) and $wrev == $meta->{revision
} and $state->{entries
}{$filename}{modified_filename
} );
1484 # Needs Merge if working copy revision is less than repo copy and there are local changes
1485 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision
} ) and $meta->{revision
} > $wrev and $state->{entries
}{$filename}{modified_filename
} );
1487 $status ||= "Locally Added" if ( defined ( $state->{entries
}{$filename}{revision
} ) and not defined ( $meta->{revision
} ) );
1488 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision
} ) and -$wrev == $meta->{revision
} );
1489 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries
}{$filename}{conflict
} ) and $state->{entries
}{$filename}{conflict
} =~ /^\+=/ );
1490 $status ||= "File had conflicts on merge" if ( 0 );
1492 $status ||= "Unknown";
1494 my ($filepart) = filenamesplit
($filename);
1496 print "M ===================================================================\n";
1497 print "M File: $filepart\tStatus: $status\n";
1498 if ( defined($state->{entries
}{$filename}{revision
}) )
1500 print "M Working revision:\t" . $state->{entries
}{$filename}{revision
} . "\n";
1502 print "M Working revision:\tNo entry for $filename\n";
1504 if ( defined($meta->{revision
}) )
1506 print "M Repository revision:\t1." . $meta->{revision
} . "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
1507 print "M Sticky Tag:\t\t(none)\n";
1508 print "M Sticky Date:\t\t(none)\n";
1509 print "M Sticky Options:\t\t(none)\n";
1511 print "M Repository revision:\tNo revision control file\n";
1521 my ( $cmd, $data ) = @_;
1525 $log->debug("req_diff : " . ( defined($data) ?
$data : "[NULL]" ));
1526 #$log->debug("status state : " . Dumper($state));
1528 my ($revision1, $revision2);
1529 if ( defined ( $state->{opt
}{r
} ) and ref $state->{opt
}{r
} eq "ARRAY" )
1531 $revision1 = $state->{opt
}{r
}[0];
1532 $revision2 = $state->{opt
}{r
}[1];
1534 $revision1 = $state->{opt
}{r
};
1537 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1538 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1540 $log->debug("Diffing revisions " . ( defined($revision1) ?
$revision1 : "[NULL]" ) . " and " . ( defined($revision2) ?
$revision2 : "[NULL]" ) );
1542 # Grab a handle to the SQLite db and do any necessary updates
1543 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1546 # if no files were specified, we need to work out what files we should be providing status on ...
1547 argsfromdir
($updater);
1549 # foreach file specified on the command line ...
1550 foreach my $filename ( @
{$state->{args
}} )
1552 $filename = filecleanup
($filename);
1554 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1556 my $wrev = revparse
($filename);
1558 # We need _something_ to diff against
1559 next unless ( defined ( $wrev ) );
1561 # if we have a -r switch, use it
1562 if ( defined ( $revision1 ) )
1564 ( undef, $file1 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1565 $meta1 = $updater->getmeta($filename, $revision1);
1566 unless ( defined ( $meta1 ) and $meta1->{filehash
} ne "deleted" )
1568 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1571 transmitfile
($meta1->{filehash
}, { targetfile
=> $file1 });
1573 # otherwise we just use the working copy revision
1576 ( undef, $file1 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1577 $meta1 = $updater->getmeta($filename, $wrev);
1578 transmitfile
($meta1->{filehash
}, { targetfile
=> $file1 });
1581 # if we have a second -r switch, use it too
1582 if ( defined ( $revision2 ) )
1584 ( undef, $file2 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1585 $meta2 = $updater->getmeta($filename, $revision2);
1587 unless ( defined ( $meta2 ) and $meta2->{filehash
} ne "deleted" )
1589 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1593 transmitfile
($meta2->{filehash
}, { targetfile
=> $file2 });
1595 # otherwise we just use the working copy
1598 $file2 = $state->{entries
}{$filename}{modified_filename
};
1601 # if we have been given -r, and we don't have a $file2 yet, lets get one
1602 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1604 ( undef, $file2 ) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
1605 $meta2 = $updater->getmeta($filename, $wrev);
1606 transmitfile
($meta2->{filehash
}, { targetfile
=> $file2 });
1609 # We need to have retrieved something useful
1610 next unless ( defined ( $meta1 ) );
1612 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1613 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision
}
1615 ( ( $state->{entries
}{$filename}{unchanged
} and ( not defined ( $state->{entries
}{$filename}{conflict
} ) or $state->{entries
}{$filename}{conflict
} !~ /^\+=/ ) )
1616 or ( defined($state->{entries
}{$filename}{modified_hash
}) and $state->{entries
}{$filename}{modified_hash
} eq $meta1->{filehash
} ) )
1619 # Apparently we only show diffs for locally modified files
1620 next unless ( defined($meta2) or defined ( $state->{entries
}{$filename}{modified_filename
} ) );
1622 print "M Index: $filename\n";
1623 print "M ===================================================================\n";
1624 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1625 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1626 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1628 foreach my $opt ( keys %{$state->{opt
}} )
1630 if ( ref $state->{opt
}{$opt} eq "ARRAY" )
1632 foreach my $value ( @
{$state->{opt
}{$opt}} )
1634 print "-$opt $value ";
1638 print "$state->{opt}{$opt} " if ( defined ( $state->{opt
}{$opt} ) );
1641 print "$filename\n";
1643 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision
} or "workingcopy" ));
1645 ( $fh, $filediff ) = tempfile
( DIR
=> $TEMP_DIR );
1647 if ( exists $state->{opt
}{u
} )
1649 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision
}) ?
"revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1651 system("diff $file1 $file2 > $filediff");
1666 my ( $cmd, $data ) = @_;
1670 $log->debug("req_log : " . ( defined($data) ?
$data : "[NULL]" ));
1671 #$log->debug("log state : " . Dumper($state));
1673 my ( $minrev, $maxrev );
1674 if ( defined ( $state->{opt
}{r
} ) and $state->{opt
}{r
} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1679 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1680 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1681 $minrev++ if ( defined($minrev) and $control eq "::" );
1684 # Grab a handle to the SQLite db and do any necessary updates
1685 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1688 # if no files were specified, we need to work out what files we should be providing status on ...
1689 argsfromdir
($updater);
1691 # foreach file specified on the command line ...
1692 foreach my $filename ( @
{$state->{args
}} )
1694 $filename = filecleanup
($filename);
1696 my $headmeta = $updater->getmeta($filename);
1698 my $revisions = $updater->getlog($filename);
1699 my $totalrevisions = scalar(@
$revisions);
1701 if ( defined ( $minrev ) )
1703 $log->debug("Removing revisions less than $minrev");
1704 while ( scalar(@
$revisions) > 0 and $revisions->[-1]{revision
} < $minrev )
1709 if ( defined ( $maxrev ) )
1711 $log->debug("Removing revisions greater than $maxrev");
1712 while ( scalar(@
$revisions) > 0 and $revisions->[0]{revision
} > $maxrev )
1718 next unless ( scalar(@
$revisions) );
1721 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1722 print "M Working file: $filename\n";
1723 print "M head: 1.$headmeta->{revision}\n";
1724 print "M branch:\n";
1725 print "M locks: strict\n";
1726 print "M access list:\n";
1727 print "M symbolic names:\n";
1728 print "M keyword substitution: kv\n";
1729 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@
$revisions) . "\n";
1730 print "M description:\n";
1732 foreach my $revision ( @
$revisions )
1734 print "M ----------------------------\n";
1735 print "M revision 1.$revision->{revision}\n";
1736 # reformat the date for log output
1737 $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}) );
1738 $revision->{author
} = cvs_author
($revision->{author
});
1739 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash
} eq "deleted" ?
"dead" : "Exp" ) . "; lines: +2 -3\n";
1740 my $commitmessage = $updater->commitmessage($revision->{commithash
});
1741 $commitmessage =~ s/^/M /mg;
1742 print $commitmessage . "\n";
1744 print "M =============================================================================\n";
1752 my ( $cmd, $data ) = @_;
1754 argsplit
("annotate");
1756 $log->info("req_annotate : " . ( defined($data) ?
$data : "[NULL]" ));
1757 #$log->debug("status state : " . Dumper($state));
1759 # Grab a handle to the SQLite db and do any necessary updates
1760 my $updater = GITCVS
::updater
->new($state->{CVSROOT
}, $state->{module
}, $log);
1763 # if no files were specified, we need to work out what files we should be providing annotate on ...
1764 argsfromdir
($updater);
1766 # we'll need a temporary checkout dir
1769 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
1771 # foreach file specified on the command line ...
1772 foreach my $filename ( @
{$state->{args
}} )
1774 $filename = filecleanup
($filename);
1776 my $meta = $updater->getmeta($filename);
1778 next unless ( $meta->{revision
} );
1780 # get all the commits that this file was in
1781 # in dense format -- aka skip dead revisions
1782 my $revisions = $updater->gethistorydense($filename);
1783 my $lastseenin = $revisions->[0][2];
1785 # populate the temporary index based on the latest commit were we saw
1786 # the file -- but do it cheaply without checking out any files
1787 # TODO: if we got a revision from the client, use that instead
1788 # to look up the commithash in sqlite (still good to default to
1789 # the current head as we do now)
1790 system("git-read-tree", $lastseenin);
1793 print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
1796 $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
1798 # do a checkout of the file
1799 system('git-checkout-index', '-f', '-u', $filename);
1801 print "E error running git-checkout-index -f -u $filename : $!\n";
1805 $log->info("Annotate $filename");
1807 # Prepare a file with the commits from the linearized
1808 # history that annotate should know about. This prevents
1809 # git-jsannotate telling us about commits we are hiding
1812 my $a_hints = "$work->{workDir}/.annotate_hints";
1813 if (!open(ANNOTATEHINTS
, '>', $a_hints)) {
1814 print "E failed to open '$a_hints' for writing: $!\n";
1817 for (my $i=0; $i < @
$revisions; $i++)
1819 print ANNOTATEHINTS
$revisions->[$i][2];
1820 if ($i+1 < @
$revisions) { # have we got a parent?
1821 print ANNOTATEHINTS
' ' . $revisions->[$i+1][2];
1823 print ANNOTATEHINTS
"\n";
1826 print ANNOTATEHINTS
"\n";
1828 or (print "E failed to write $a_hints: $!\n"), return;
1830 my @cmd = (qw(git-annotate -l -S), $a_hints, $filename);
1831 if (!open(ANNOTATE
, "-|", @cmd)) {
1832 print "E error invoking ". join(' ',@cmd) .": $!\n";
1836 print "E Annotations for $filename\n";
1837 print "E ***************\n";
1838 while ( <ANNOTATE
> )
1840 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1842 my $commithash = $1;
1844 unless ( defined ( $metadata->{$commithash} ) )
1846 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1847 $metadata->{$commithash}{author
} = cvs_author
($metadata->{$commithash}{author
});
1848 $metadata->{$commithash}{modified
} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified
} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1850 printf("M 1.%-5d (%-8s %10s): %s\n",
1851 $metadata->{$commithash}{revision
},
1852 $metadata->{$commithash}{author
},
1853 $metadata->{$commithash}{modified
},
1857 $log->warn("Error in annotate output! LINE: $_");
1858 print "E Annotate error \n";
1865 # done; get out of the tempdir
1872 # This method takes the state->{arguments} array and produces two new arrays.
1873 # The first is $state->{args} which is everything before the '--' argument, and
1874 # the second is $state->{files} which is everything after it.
1877 $state->{args
} = [];
1878 $state->{files
} = [];
1881 return unless( defined($state->{arguments
}) and ref $state->{arguments
} eq "ARRAY" );
1885 if ( defined($type) )
1888 $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" );
1889 $opt = { v
=> 0, l
=> 0, R
=> 0 } if ( $type eq "status" );
1890 $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" );
1891 $opt = { l
=> 0, R
=> 0, k
=> 1, D
=> 1, D
=> 1, r
=> 2 } if ( $type eq "diff" );
1892 $opt = { c
=> 0, R
=> 0, l
=> 0, f
=> 0, F
=> 1, m
=> 1, r
=> 1 } if ( $type eq "ci" );
1893 $opt = { k
=> 1, m
=> 1 } if ( $type eq "add" );
1894 $opt = { f
=> 0, l
=> 0, R
=> 0 } if ( $type eq "remove" );
1895 $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" );
1898 while ( scalar ( @
{$state->{arguments
}} ) > 0 )
1900 my $arg = shift @
{$state->{arguments
}};
1902 next if ( $arg eq "--" );
1903 next unless ( $arg =~ /\S/ );
1905 # if the argument looks like a switch
1906 if ( $arg =~ /^-(\w)(.*)/ )
1908 # if it's a switch that takes an argument
1911 # If this switch has already been provided
1912 if ( $opt->{$1} > 1 and exists ( $state->{opt
}{$1} ) )
1914 $state->{opt
}{$1} = [ $state->{opt
}{$1} ];
1915 if ( length($2) > 0 )
1917 push @
{$state->{opt
}{$1}},$2;
1919 push @
{$state->{opt
}{$1}}, shift @
{$state->{arguments
}};
1922 # if there's extra data in the arg, use that as the argument for the switch
1923 if ( length($2) > 0 )
1925 $state->{opt
}{$1} = $2;
1927 $state->{opt
}{$1} = shift @
{$state->{arguments
}};
1931 $state->{opt
}{$1} = undef;
1936 push @
{$state->{args
}}, $arg;
1944 foreach my $value ( @
{$state->{arguments
}} )
1946 if ( $value eq "--" )
1951 push @
{$state->{args
}}, $value if ( $mode == 0 );
1952 push @
{$state->{files
}}, $value if ( $mode == 1 );
1957 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1960 my $updater = shift;
1962 $state->{args
} = [] if ( scalar(@
{$state->{args
}}) == 1 and $state->{args
}[0] eq "." );
1964 return if ( scalar ( @
{$state->{args
}} ) > 1 );
1966 my @gethead = @
{$updater->gethead};
1969 foreach my $file (keys %{$state->{entries
}}) {
1970 if ( exists $state->{entries
}{$file}{revision
} &&
1971 $state->{entries
}{$file}{revision
} == 0 )
1973 push @gethead, { name
=> $file, filehash
=> 'added' };
1977 if ( scalar(@
{$state->{args
}}) == 1 )
1979 my $arg = $state->{args
}[0];
1980 $arg .= $state->{prependdir
} if ( defined ( $state->{prependdir
} ) );
1982 $log->info("Only one arg specified, checking for directory expansion on '$arg'");
1984 foreach my $file ( @gethead )
1986 next if ( $file->{filehash
} eq "deleted" and not defined ( $state->{entries
}{$file->{name
}} ) );
1987 next unless ( $file->{name
} =~ /^$arg\// or $file->{name
} eq $arg );
1988 push @
{$state->{args
}}, $file->{name
};
1991 shift @
{$state->{args
}} if ( scalar(@
{$state->{args
}}) > 1 );
1993 $log->info("Only one arg specified, populating file list automatically");
1995 $state->{args
} = [];
1997 foreach my $file ( @gethead )
1999 next if ( $file->{filehash
} eq "deleted" and not defined ( $state->{entries
}{$file->{name
}} ) );
2000 next unless ( $file->{name
} =~ s/^$state->{prependdir}// );
2001 push @
{$state->{args
}}, $file->{name
};
2006 # This method cleans up the $state variable after a command that uses arguments has run
2009 $state->{files
} = [];
2010 $state->{args
} = [];
2011 $state->{arguments
} = [];
2012 $state->{entries
} = {};
2017 my $filename = shift;
2019 return undef unless ( defined ( $state->{entries
}{$filename}{revision
} ) );
2021 return $1 if ( $state->{entries
}{$filename}{revision
} =~ /^1\.(\d+)/ );
2022 return -$1 if ( $state->{entries
}{$filename}{revision
} =~ /^-1\.(\d+)/ );
2027 # This method takes a file hash and does a CVS "file transfer". Its
2028 # exact behaviour depends on a second, optional hash table argument:
2029 # - If $options->{targetfile}, dump the contents to that file;
2030 # - If $options->{print}, use M/MT to transmit the contents one line
2032 # - Otherwise, transmit the size of the file, followed by the file
2036 my $filehash = shift;
2037 my $options = shift;
2039 if ( defined ( $filehash ) and $filehash eq "deleted" )
2041 $log->warn("filehash is 'deleted'");
2045 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2047 my $type = `git-cat-file -t $filehash`;
2050 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2052 my $size = `git-cat-file -s $filehash`;
2055 $log->debug("transmitfile($filehash) size=$size, type=$type");
2057 if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
2059 if ( defined ( $options->{targetfile
} ) )
2061 my $targetfile = $options->{targetfile
};
2062 open NEWFILE
, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2063 print NEWFILE
$_ while ( <$fh> );
2064 close NEWFILE
or die("Failed to write '$targetfile': $!");
2065 } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2070 print 'MT text ', $_, "\n";
2075 print while ( <$fh> );
2077 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
2079 die("Couldn't execute git-cat-file");
2083 # This method takes a file name, and returns ( $dirpart, $filepart ) which
2084 # refers to the directory portion and the file portion of the filename
2088 my $filename = shift;
2089 my $fixforlocaldir = shift;
2091 my ( $filepart, $dirpart ) = ( $filename, "." );
2092 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2095 if ( $fixforlocaldir )
2097 $dirpart =~ s/^$state->{prependdir}//;
2100 return ( $filepart, $dirpart );
2105 my $filename = shift;
2107 return undef unless(defined($filename));
2108 if ( $filename =~ /^\// )
2110 print "E absolute filenames '$filename' not supported by server\n";
2114 $filename =~ s/^\.\///g
;
2115 $filename = $state->{prependdir
} . $filename;
2121 if( !defined($state->{CVSROOT
}) )
2123 print "error 1 CVSROOT not specified\n";
2127 if( $ENV{GIT_DIR
} ne ($state->{CVSROOT
} . '/') )
2129 print "error 1 Internally inconsistent CVSROOT\n";
2135 # Setup working directory in a work tree with the requested version
2136 # loaded in the index.
2143 if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2144 defined($work->{tmpDir
}) )
2146 $log->warn("Bad work tree state management");
2147 print "error 1 Internal setup multiple work trees without cleanup\n";
2152 $work->{workDir
} = tempdir
( DIR
=> $TEMP_DIR );
2154 if( !defined($work->{index}) )
2156 (undef, $work->{index}) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
2159 chdir $work->{workDir
} or
2160 die "Unable to chdir to $work->{workDir}\n";
2162 $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
2164 $ENV{GIT_WORK_TREE
} = ".";
2165 $ENV{GIT_INDEX_FILE
} = $work->{index};
2170 system("git","read-tree",$ver);
2173 $log->warn("Error running git-read-tree");
2174 die "Error running git-read-tree $ver in $work->{workDir} $!\n";
2177 # else # req_annotate reads tree for each file
2180 # Ensure current directory is in some kind of working directory,
2181 # with a recent version loaded in the index.
2184 if( defined($work->{tmpDir
}) )
2186 $log->warn("Bad work tree state management [ensureWorkTree()]");
2187 print "error 1 Internal setup multiple dirs without cleanup\n";
2191 if( $work->{state} )
2198 if( !defined($work->{emptyDir
}) )
2200 $work->{emptyDir
} = tempdir
( DIR
=> $TEMP_DIR, OPEN
=> 0);
2202 chdir $work->{emptyDir
} or
2203 die "Unable to chdir to $work->{emptyDir}\n";
2205 my $ver = `git show-ref -s refs/heads/$state->{module}`;
2207 if ($ver !~ /^[0-9a-f]{40}$/)
2209 $log->warn("Error from git show-ref -s refs/head$state->{module}");
2210 print "error 1 cannot find the current HEAD of module";
2215 if( !defined($work->{index}) )
2217 (undef, $work->{index}) = tempfile
( DIR
=> $TEMP_DIR, OPEN
=> 0 );
2220 $ENV{GIT_WORK_TREE
} = ".";
2221 $ENV{GIT_INDEX_FILE
} = $work->{index};
2224 system("git","read-tree",$ver);
2227 die "Error running git-read-tree $ver $!\n";
2231 # Cleanup working directory that is not needed any longer.
2234 if( ! $work->{state} )
2239 chdir "/" or die "Unable to chdir '/'\n";
2241 if( defined($work->{workDir
}) )
2243 rmtree
( $work->{workDir
} );
2244 undef $work->{workDir
};
2246 undef $work->{state};
2249 # Setup a temporary directory (not a working tree), typically for
2250 # merging dirty state as in req_update.
2253 $work->{tmpDir
} = tempdir
( DIR
=> $TEMP_DIR );
2254 chdir $work->{tmpDir
} or die "Unable to chdir $work->{tmpDir}\n";
2256 return $work->{tmpDir
};
2259 # Clean up a previously setupTmpDir. Restore previous work tree if
2263 if ( !defined($work->{tmpDir
}) )
2265 $log->warn("cleanup tmpdir that has not been setup");
2266 die "Cleanup tmpDir that has not been setup\n";
2268 if( defined($work->{state}) )
2270 if( $work->{state} == 1 )
2272 chdir $work->{emptyDir
} or
2273 die "Unable to chdir to $work->{emptyDir}\n";
2275 elsif( $work->{state} == 2 )
2277 chdir $work->{workDir
} or
2278 die "Unable to chdir to $work->{emptyDir}\n";
2282 $log->warn("Inconsistent work dir state");
2283 die "Inconsistent work dir state\n";
2288 chdir "/" or die "Unable to chdir '/'\n";
2292 # Given a path, this function returns a string containing the kopts
2293 # that should go into that path's Entries line. For example, a binary
2294 # file should get -kb.
2299 # Once it exists, the git attributes system should be used to look up
2300 # what attributes apply to this path.
2302 # Until then, take the setting from the config file
2303 unless ( defined ( $cfg->{gitcvs
}{allbinary
} ) and $cfg->{gitcvs
}{allbinary
} =~ /^\s*(1|true|yes)\s*$/i )
2305 # Return "" to give no special treatment to any path
2308 # Alternatively, to have all files treated as if they are binary (which
2309 # is more like git itself), always return the "-kb" option
2314 # Generate a CVS author name from Git author information, by taking
2315 # the first eight characters of the user part of the email address.
2318 my $author_line = shift;
2319 (my $author) = $author_line =~ /<([^>@]{1,8})/;
2324 package GITCVS
::log;
2327 #### Copyright The Open University UK - 2006.
2329 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
2330 #### Martin Langhoff <martin@catalyst.net.nz>
2343 This module provides very crude logging with a similar interface to
2352 Creates a new log object, optionally you can specify a filename here to
2353 indicate the file to log to. If no log file is specified, you can specify one
2354 later with method setfile, or indicate you no longer want logging with method
2357 Until one of these methods is called, all log calls will buffer messages ready
2364 my $filename = shift;
2368 bless $self, $class;
2370 if ( defined ( $filename ) )
2372 open $self->{fh
}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2380 This methods takes a filename, and attempts to open that file as the log file.
2381 If successful, all buffered data is written out to the file, and any further
2382 logging is written directly to the file.
2388 my $filename = shift;
2390 if ( defined ( $filename ) )
2392 open $self->{fh
}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2395 return unless ( defined ( $self->{buffer
} ) and ref $self->{buffer
} eq "ARRAY" );
2397 while ( my $line = shift @
{$self->{buffer
}} )
2399 print {$self->{fh
}} $line;
2405 This method indicates no logging is going to be used. It flushes any entries in
2406 the internal buffer, and sets a flag to ensure no further data is put there.
2415 return unless ( defined ( $self->{buffer
} ) and ref $self->{buffer
} eq "ARRAY" );
2417 $self->{buffer
} = [];
2422 Internal method. Returns true if the log file is open, false otherwise.
2429 return 1 if ( defined ( $self->{fh
} ) and ref $self->{fh
} eq "GLOB" );
2433 =head2 debug info warn fatal
2435 These four methods are wrappers to _log. They provide the actual interface for
2439 sub debug
{ my $self = shift; $self->_log("debug", @_); }
2440 sub info
{ my $self = shift; $self->_log("info" , @_); }
2441 sub warn { my $self = shift; $self->_log("warn" , @_); }
2442 sub fatal
{ my $self = shift; $self->_log("fatal", @_); }
2446 This is an internal method called by the logging functions. It generates a
2447 timestamp and pushes the logged line either to file, or internal buffer.
2455 return if ( $self->{nolog
} );
2457 my @time = localtime;
2458 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2468 if ( $self->_logopen )
2470 print {$self->{fh
}} $timestring . " - " . join(" ",@_) . "\n";
2472 push @
{$self->{buffer
}}, $timestring . " - " . join(" ",@_) . "\n";
2478 This method simply closes the file handle if one is open
2485 if ( $self->_logopen )
2491 package GITCVS
::updater
;
2494 #### Copyright The Open University UK - 2006.
2496 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
2497 #### Martin Langhoff <martin@catalyst.net.nz>
2519 die "Need to specify a git repository" unless ( defined($config) and -d
$config );
2520 die "Need to specify a module" unless ( defined($module) );
2522 $class = ref($class) || $class;
2526 bless $self, $class;
2528 $self->{valid_tables
} = {'revision' => 1,
2529 'revision_ix1' => 1,
2530 'revision_ix2' => 1,
2536 $self->{module
} = $module;
2537 $self->{git_path
} = $config . "/";
2539 $self->{log} = $log;
2541 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d
$self->{git_path
} );
2543 $self->{dbdriver
} = $cfg->{gitcvs
}{$state->{method
}}{dbdriver
} ||
2544 $cfg->{gitcvs
}{dbdriver
} || "SQLite";
2545 $self->{dbname
} = $cfg->{gitcvs
}{$state->{method
}}{dbname
} ||
2546 $cfg->{gitcvs
}{dbname
} || "%Ggitcvs.%m.sqlite";
2547 $self->{dbuser
} = $cfg->{gitcvs
}{$state->{method
}}{dbuser
} ||
2548 $cfg->{gitcvs
}{dbuser
} || "";
2549 $self->{dbpass
} = $cfg->{gitcvs
}{$state->{method
}}{dbpass
} ||
2550 $cfg->{gitcvs
}{dbpass
} || "";
2551 $self->{dbtablenameprefix
} = $cfg->{gitcvs
}{$state->{method
}}{dbtablenameprefix
} ||
2552 $cfg->{gitcvs
}{dbtablenameprefix
} || "";
2553 my %mapping = ( m
=> $module,
2554 a
=> $state->{method
},
2555 u
=> getlogin || getpwuid($<) || $<,
2556 G
=> $self->{git_path
},
2557 g
=> mangle_dirname
($self->{git_path
}),
2559 $self->{dbname
} =~ s/%([mauGg])/$mapping{$1}/eg;
2560 $self->{dbuser
} =~ s/%([mauGg])/$mapping{$1}/eg;
2561 $self->{dbtablenameprefix
} =~ s/%([mauGg])/$mapping{$1}/eg;
2562 $self->{dbtablenameprefix
} = mangle_tablename
($self->{dbtablenameprefix
});
2564 die "Invalid char ':' in dbdriver" if $self->{dbdriver
} =~ /:/;
2565 die "Invalid char ';' in dbname" if $self->{dbname
} =~ /;/;
2566 $self->{dbh
} = DBI
->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
2569 die "Error connecting to database\n" unless defined $self->{dbh
};
2571 $self->{tables
} = {};
2572 foreach my $table ( keys %{$self->{dbh
}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
2574 $self->{tables
}{$table} = 1;
2577 # Construct the revision table if required
2578 unless ( $self->{tables
}{$self->tablename("revision")} )
2580 my $tablename = $self->tablename("revision");
2581 my $ix1name = $self->tablename("revision_ix1");
2582 my $ix2name = $self->tablename("revision_ix2");
2584 CREATE TABLE $tablename (
2586 revision INTEGER NOT NULL,
2587 filehash TEXT NOT NULL,
2588 commithash TEXT NOT NULL,
2589 author TEXT NOT NULL,
2590 modified TEXT NOT NULL,
2595 CREATE INDEX $ix1name
2596 ON $tablename (name,revision)
2599 CREATE INDEX $ix2name
2600 ON $tablename (name,commithash)
2604 # Construct the head table if required
2605 unless ( $self->{tables
}{$self->tablename("head")} )
2607 my $tablename = $self->tablename("head");
2608 my $ix1name = $self->tablename("head_ix1");
2610 CREATE TABLE $tablename (
2612 revision INTEGER NOT NULL,
2613 filehash TEXT NOT NULL,
2614 commithash TEXT NOT NULL,
2615 author TEXT NOT NULL,
2616 modified TEXT NOT NULL,
2621 CREATE INDEX $ix1name
2622 ON $tablename (name)
2626 # Construct the properties table if required
2627 unless ( $self->{tables
}{$self->tablename("properties")} )
2629 my $tablename = $self->tablename("properties");
2631 CREATE TABLE $tablename (
2632 key TEXT NOT NULL PRIMARY KEY,
2638 # Construct the commitmsgs table if required
2639 unless ( $self->{tables
}{$self->tablename("commitmsgs")} )
2641 my $tablename = $self->tablename("commitmsgs");
2643 CREATE TABLE $tablename (
2644 key TEXT NOT NULL PRIMARY KEY,
2661 if (exists $self->{valid_tables
}{$name}) {
2662 return $self->{dbtablenameprefix
} . $name;
2675 # first lets get the commit list
2676 $ENV{GIT_DIR
} = $self->{git_path
};
2678 my $commitsha1 = `git rev-parse $self->{module}`;
2681 my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
2682 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2684 die("Invalid module '$self->{module}'");
2689 my $lastcommit = $self->_get_prop("last_commit");
2691 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
2695 # Start exclusive lock here...
2696 $self->{dbh
}->begin_work() or die "Cannot lock database for BEGIN";
2698 # TODO: log processing is memory bound
2699 # if we can parse into a 2nd file that is in reverse order
2700 # we can probably do something really efficient
2701 my @git_log_params = ('--pretty', '--parents', '--topo-order');
2703 if (defined $lastcommit) {
2704 push @git_log_params, "$lastcommit..$self->{module}";
2706 push @git_log_params, $self->{module
};
2708 # git-rev-list is the backend / plumbing version of git-log
2709 open(GITLOG
, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2718 if (m/^commit\s+(.*)$/) {
2719 # on ^commit lines put the just seen commit in the stack
2720 # and prime things for the next one
2723 unshift @commits, \
%copy;
2726 my @parents = split(m/\s+/, $1);
2727 $commit{hash
} = shift @parents;
2728 $commit{parents
} = \
@parents;
2729 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message
})) {
2730 # on rfc822-like lines seen before we see any message,
2731 # lowercase the entry and put it in the hash as key-value
2732 $commit{lc($1)} = $2;
2734 # message lines - skip initial empty line
2735 # and trim whitespace
2736 if (!exists($commit{message
}) && m/^\s*$/) {
2737 # define it to mark the end of headers
2738 $commit{message
} = '';
2741 s/^\s+//; s/\s+$//; # trim ws
2742 $commit{message
} .= $_ . "\n";
2747 unshift @commits, \
%commit if ( keys %commit );
2749 # Now all the commits are in the @commits bucket
2750 # ordered by time DESC. for each commit that needs processing,
2751 # determine whether it's following the last head we've seen or if
2752 # it's on its own branch, grab a file list, and add whatever's changed
2753 # NOTE: $lastcommit refers to the last commit from previous run
2754 # $lastpicked is the last commit we picked in this run
2757 if (defined $lastcommit) {
2758 $lastpicked = $lastcommit;
2761 my $committotal = scalar(@commits);
2762 my $commitcount = 0;
2764 # Load the head table into $head (for cached lookups during the update process)
2765 foreach my $file ( @
{$self->gethead()} )
2767 $head->{$file->{name
}} = $file;
2770 foreach my $commit ( @commits )
2772 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2773 if (defined $lastpicked)
2775 if (!in_array
($lastpicked, @
{$commit->{parents
}}))
2777 # skip, we'll see this delta
2778 # as part of a merge later
2779 # warn "skipping off-track $commit->{hash}\n";
2781 } elsif (@
{$commit->{parents
}} > 1) {
2782 # it is a merge commit, for each parent that is
2783 # not $lastpicked, see if we can get a log
2784 # from the merge-base to that parent to put it
2785 # in the message as a merge summary.
2786 my @parents = @
{$commit->{parents
}};
2787 foreach my $parent (@parents) {
2788 # git-merge-base can potentially (but rarely) throw
2789 # several candidate merge bases. let's assume
2790 # that the first one is the best one.
2791 if ($parent eq $lastpicked) {
2795 safe_pipe_capture
('git-merge-base',
2796 $lastpicked, $parent);
2798 # The two branches may not be related at all,
2799 # in which case merge base simply fails to find
2800 # any, but that's Ok.
2806 # print "want to log between $base $parent \n";
2807 open(GITLOG
, '-|', 'git-log', '--pretty=medium', "$base..$parent")
2808 or die "Cannot call git-log: $!";
2812 if (!defined $mergedhash) {
2813 if (m/^commit\s+(.+)$/) {
2819 # grab the first line that looks non-rfc822
2820 # aka has content after leading space
2821 if (m/^\s+(\S.*)$/) {
2823 $title = substr($title,0,100); # truncate
2824 unshift @merged, "$mergedhash $title";
2831 $commit->{mergemsg
} = $commit->{message
};
2832 $commit->{mergemsg
} .= "\nSummary of merged commits:\n\n";
2833 foreach my $summary (@merged) {
2834 $commit->{mergemsg
} .= "\t$summary\n";
2836 $commit->{mergemsg
} .= "\n\n";
2837 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2844 # convert the date to CVS-happy format
2845 $commit->{date
} = "$2 $1 $4 $3 $5" if ( $commit->{date
} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2847 if ( defined ( $lastpicked ) )
2849 my $filepipe = open(FILELIST
, '-|', 'git-diff-tree', '-z', '-r', $lastpicked, $commit->{hash
}) or die("Cannot call git-diff-tree : $!");
2851 while ( <FILELIST
> )
2854 unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
2856 die("Couldn't process git-diff-tree line : $_");
2858 my ($mode, $hash, $change) = ($1, $2, $3);
2859 my $name = <FILELIST
>;
2862 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
2865 $git_perms .= "r" if ( $mode & 4 );
2866 $git_perms .= "w" if ( $mode & 2 );
2867 $git_perms .= "x" if ( $mode & 1 );
2868 $git_perms = "rw" if ( $git_perms eq "" );
2870 if ( $change eq "D" )
2872 #$log->debug("DELETE $name");
2875 revision
=> $head->{$name}{revision
} + 1,
2876 filehash
=> "deleted",
2877 commithash
=> $commit->{hash
},
2878 modified
=> $commit->{date
},
2879 author
=> $commit->{author
},
2882 $self->insert_rev($name, $head->{$name}{revision
}, $hash, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2884 elsif ( $change eq "M" || $change eq "T" )
2886 #$log->debug("MODIFIED $name");
2889 revision
=> $head->{$name}{revision
} + 1,
2891 commithash
=> $commit->{hash
},
2892 modified
=> $commit->{date
},
2893 author
=> $commit->{author
},
2896 $self->insert_rev($name, $head->{$name}{revision
}, $hash, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2898 elsif ( $change eq "A" )
2900 #$log->debug("ADDED $name");
2903 revision
=> $head->{$name}{revision
} ?
$head->{$name}{revision
}+1 : 1,
2905 commithash
=> $commit->{hash
},
2906 modified
=> $commit->{date
},
2907 author
=> $commit->{author
},
2910 $self->insert_rev($name, $head->{$name}{revision
}, $hash, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2914 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
2920 # this is used to detect files removed from the repo
2921 my $seen_files = {};
2923 my $filepipe = open(FILELIST
, '-|', 'git-ls-tree', '-z', '-r', $commit->{hash
}) or die("Cannot call git-ls-tree : $!");
2925 while ( <FILELIST
> )
2928 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
2930 die("Couldn't process git-ls-tree line : $_");
2933 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2935 $seen_files->{$git_filename} = 1;
2937 my ( $oldhash, $oldrevision, $oldmode ) = (
2938 $head->{$git_filename}{filehash
},
2939 $head->{$git_filename}{revision
},
2940 $head->{$git_filename}{mode
}
2943 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2946 $git_perms .= "r" if ( $1 & 4 );
2947 $git_perms .= "w" if ( $1 & 2 );
2948 $git_perms .= "x" if ( $1 & 1 );
2953 # unless the file exists with the same hash, we need to update it ...
2954 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2956 my $newrevision = ( $oldrevision or 0 ) + 1;
2958 $head->{$git_filename} = {
2959 name
=> $git_filename,
2960 revision
=> $newrevision,
2961 filehash
=> $git_hash,
2962 commithash
=> $commit->{hash
},
2963 modified
=> $commit->{date
},
2964 author
=> $commit->{author
},
2969 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $git_perms);
2974 # Detect deleted files
2975 foreach my $file ( keys %$head )
2977 unless ( exists $seen_files->{$file} or $head->{$file}{filehash
} eq "deleted" )
2979 $head->{$file}{revision
}++;
2980 $head->{$file}{filehash
} = "deleted";
2981 $head->{$file}{commithash
} = $commit->{hash
};
2982 $head->{$file}{modified
} = $commit->{date
};
2983 $head->{$file}{author
} = $commit->{author
};
2985 $self->insert_rev($file, $head->{$file}{revision
}, $head->{$file}{filehash
}, $commit->{hash
}, $commit->{date
}, $commit->{author
}, $head->{$file}{mode
});
2988 # END : "Detect deleted files"
2992 if (exists $commit->{mergemsg
})
2994 $self->insert_mergelog($commit->{hash
}, $commit->{mergemsg
});
2997 $lastpicked = $commit->{hash
};
2999 $self->_set_prop("last_commit", $commit->{hash
});
3002 $self->delete_head();
3003 foreach my $file ( keys %$head )
3007 $head->{$file}{revision
},
3008 $head->{$file}{filehash
},
3009 $head->{$file}{commithash
},
3010 $head->{$file}{modified
},
3011 $head->{$file}{author
},
3012 $head->{$file}{mode
},
3015 # invalidate the gethead cache
3016 $self->{gethead_cache
} = undef;
3019 # Ending exclusive lock here
3020 $self->{dbh
}->commit() or die "Failed to commit changes to SQLite";
3027 my $revision = shift;
3028 my $filehash = shift;
3029 my $commithash = shift;
3030 my $modified = shift;
3033 my $tablename = $self->tablename("revision");
3035 my $insert_rev = $self->{dbh
}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
3036 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
3044 my $tablename = $self->tablename("commitmsgs");
3046 my $insert_mergelog = $self->{dbh
}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
3047 $insert_mergelog->execute($key, $value);
3053 my $tablename = $self->tablename("head");
3055 my $delete_head = $self->{dbh
}->prepare_cached("DELETE FROM $tablename",{},1);
3056 $delete_head->execute();
3063 my $revision = shift;
3064 my $filehash = shift;
3065 my $commithash = shift;
3066 my $modified = shift;
3069 my $tablename = $self->tablename("head");
3071 my $insert_head = $self->{dbh
}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
3072 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
3078 my $filename = shift;
3079 my $tablename = $self->tablename("head");
3081 my $db_query = $self->{dbh
}->prepare_cached("SELECT filehash, revision, mode FROM $tablename WHERE name=?",{},1);
3082 $db_query->execute($filename);
3083 my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
3085 return ( $hash, $revision, $mode );
3092 my $tablename = $self->tablename("properties");
3094 my $db_query = $self->{dbh
}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
3095 $db_query->execute($key);
3096 my ( $value ) = $db_query->fetchrow_array;
3106 my $tablename = $self->tablename("properties");
3108 my $db_query = $self->{dbh
}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
3109 $db_query->execute($value, $key);
3111 unless ( $db_query->rows )
3113 $db_query = $self->{dbh
}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
3114 $db_query->execute($key, $value);
3127 my $tablename = $self->tablename("head");
3129 return $self->{gethead_cache
} if ( defined ( $self->{gethead_cache
} ) );
3131 my $db_query = $self->{dbh
}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
3132 $db_query->execute();
3135 while ( my $file = $db_query->fetchrow_hashref )
3140 $self->{gethead_cache
} = $tree;
3152 my $filename = shift;
3153 my $tablename = $self->tablename("revision");
3155 my $db_query = $self->{dbh
}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
3156 $db_query->execute($filename);
3159 while ( my $file = $db_query->fetchrow_hashref )
3169 This function takes a filename (with path) argument and returns a hashref of
3170 metadata for that file.
3177 my $filename = shift;
3178 my $revision = shift;
3179 my $tablename_rev = $self->tablename("revision");
3180 my $tablename_head = $self->tablename("head");
3183 if ( defined($revision) and $revision =~ /^\d+$/ )
3185 $db_query = $self->{dbh
}->prepare_cached("SELECT * FROM $tablename_rev WHERE name=? AND revision=?",{},1);
3186 $db_query->execute($filename, $revision);
3188 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
3190 $db_query = $self->{dbh
}->prepare_cached("SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",{},1);
3191 $db_query->execute($filename, $revision);
3193 $db_query = $self->{dbh
}->prepare_cached("SELECT * FROM $tablename_head WHERE name=?",{},1);
3194 $db_query->execute($filename);
3197 return $db_query->fetchrow_hashref;
3200 =head2 commitmessage
3202 this function takes a commithash and returns the commit message for that commit
3208 my $commithash = shift;
3209 my $tablename = $self->tablename("commitmsgs");
3211 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
3214 $db_query = $self->{dbh
}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
3215 $db_query->execute($commithash);
3217 my ( $message ) = $db_query->fetchrow_array;
3219 if ( defined ( $message ) )
3221 $message .= " " if ( $message =~ /\n$/ );
3225 my @lines = safe_pipe_capture
("git-cat-file", "commit", $commithash);
3226 shift @lines while ( $lines[0] =~ /\S/ );
3227 $message = join("",@lines);
3228 $message .= " " if ( $message =~ /\n$/ );
3234 This function takes a filename (with path) argument and returns an arrayofarrays
3235 containing revision,filehash,commithash ordered by revision descending
3241 my $filename = shift;
3242 my $tablename = $self->tablename("revision");
3245 $db_query = $self->{dbh
}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
3246 $db_query->execute($filename);
3248 return $db_query->fetchall_arrayref;
3251 =head2 gethistorydense
3253 This function takes a filename (with path) argument and returns an arrayofarrays
3254 containing revision,filehash,commithash ordered by revision descending.
3256 This version of gethistory skips deleted entries -- so it is useful for annotate.
3257 The 'dense' part is a reference to a '--dense' option available for git-rev-list
3258 and other git tools that depend on it.
3264 my $filename = shift;
3265 my $tablename = $self->tablename("revision");
3268 $db_query = $self->{dbh
}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
3269 $db_query->execute($filename);
3271 return $db_query->fetchall_arrayref;
3276 from Array::PAT - mimics the in_array() function
3277 found in PHP. Yuck but works for small arrays.
3282 my ($check, @array) = @_;
3284 foreach my $test (@array){
3285 if($check eq $test){
3292 =head2 safe_pipe_capture
3294 an alternative to `command` that allows input to be passed as an array
3295 to work around shell problems with weird characters in arguments
3298 sub safe_pipe_capture
{
3302 if (my $pid = open my $child, '-|') {
3303 @output = (<$child>);
3304 close $child or die join(' ',@_).": $! $?";
3306 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3308 return wantarray ?
@output : join('',@output);
3311 =head2 mangle_dirname
3313 create a string from a directory name that is suitable to use as
3314 part of a filename, mainly by converting all chars except \w.- to _
3317 sub mangle_dirname
{
3318 my $dirname = shift;
3319 return unless defined $dirname;
3321 $dirname =~ s/[^\w.-]/_/g;
3326 =head2 mangle_tablename
3328 create a string from a that is suitable to use as part of an SQL table
3329 name, mainly by converting all chars except \w to _
3332 sub mangle_tablename
{
3333 my $tablename = shift;
3334 return unless defined $tablename;
3336 $tablename =~ s/[^\w_]/_/g;