]>
git.ipfire.org Git - thirdparty/git.git/blob - git-cvsexportcommit.perl
4 # - does not propagate permissions
5 # - error handling has not been extensively tested
10 use File
:: Temp
qw(tempdir) ;
12 use File
:: Basename
qw(basename dirname) ;
14 unless ( $ENV { GIT_DIR
} && - r
$ENV { GIT_DIR
}){
15 die "GIT_DIR is not defined or is unreadable" ;
18 our ( $opt_h , $opt_p , $opt_v , $opt_c , $opt_f , $opt_a , $opt_m );
24 die "Need at least one commit identifier!" unless @ARGV ;
27 our ( $tmpdir , $tmpdirname ) = tempdir
( 'git-cvsapplycommit-XXXXXX' ,
31 # resolve target commit
34 $commit = safe_pipe_capture
( 'git-rev-parse' , '--verify' , " $commit ^0" );
37 die "The commit reference $commit did not resolve!" ;
40 # resolve what parent we want
44 $parent = safe_pipe_capture
( 'git-rev-parse' , '--verify' , " $parent ^0" );
47 die "The parent reference did not resolve!" ;
51 # find parents from the commit itself
52 my @commit = safe_pipe_capture
( 'git-cat-file' , 'commit' , $commit );
56 my $stage = 'headers' ; # headers, msg
60 foreach my $line ( @commit ) {
62 if ( $stage eq 'headers' && $line eq '' ) {
67 if ( $stage eq 'headers' ) {
68 if ( $line =~ m/^parent (\w{40})$/ ) { # found a parent
70 } elsif ( $line =~ m/^author (.+) \d+ [-+]\d+$/ ) {
72 } elsif ( $line =~ m/^committer (.+) \d+ [-+]\d+$/ ) {
85 # double check that it's a valid parent
86 foreach my $p ( @parents ) {
92 die "Did not find $parent in the parents for this commit!" if ! $found ;
93 } else { # we don't have a parent from the cmdline...
94 if ( @parents == 1 ) { # it's safe to get it from the commit
95 $parent = $parents [ 0 ];
96 } else { # or perhaps not!
97 die "This commit has more than one parent -- please name the parent you want to use explicitly" ;
101 $opt_v && print "Applying to CVS commit $commit from parent $parent \n " ;
103 # grab the commit message
104 open ( MSG
, ">.msg" ) or die "Cannot open .msg for writing" ;
110 print MSG
" \n\n Author: $author \n " ;
111 if ( $author ne $committer ) {
112 print MSG
"Committer: $committer \n " ;
117 `git-diff-tree --binary -p $parent $commit >.cvsexportcommit.diff` ; # || die "Cannot diff";
119 ## apply non-binary changes
120 my $fuzz = $opt_p ?
0 : 2 ;
122 print "Checking if patch will apply \n " ;
125 open APPLY
, "GIT_DIR= git-apply -C $fuzz --binary --summary --numstat<.cvsexportcommit.diff|" || die "cannot patch" ;
127 close APPLY
|| die "Cannot patch" ;
128 my ( @bfiles , @files , @afiles , @dfiles );
131 push ( @bfiles , $1 ) if m/^-\t-\t(.*)$/ ;
132 push ( @files , $1 ) if m/^-\t-\t(.*)$/ ;
133 push ( @files , $1 ) if m/^\d+\t\d+\t(.*)$/ ;
134 push ( @afiles , $1 ) if m/^ create mode [0-7]+ (.*)$/ ;
135 push ( @dfiles , $1 ) if m/^ delete mode [0-7]+ (.*)$/ ;
137 map { s/^"(.*)"$/$1/g } @bfiles , @files ;
138 map { s/\\([0-7]{3})/sprintf('%c',oct $1)/eg } @bfiles , @files ;
140 # check that the files are clean and up to date according to cvs
143 foreach my $p ( @afiles ) {
144 my $path = dirname
$p ;
145 while (!- d
$path and ! grep { $_ eq $path } @dirs ) {
146 unshift @dirs , $path ;
147 $path = dirname
$path ;
151 foreach my $d ( @dirs ) {
154 warn " $d exists and is not a directory! \n " ;
157 foreach my $f ( @afiles ) {
158 # This should return only one value
159 if ( $f =~ m
,(.*) /[^/ ]*$,) {
161 next if ( grep { $_ eq $p } @dirs );
163 my @status = grep ( m/^File/ , safe_pipe_capture
( 'cvs' , '-q' , 'status' , $f ));
164 if ( @status > 1 ) { warn 'Strange! cvs status returned more than one line?' };
165 if (- d dirname
$f and $status [ 0 ] !~ m/Status: Unknown$/
166 and $status [ 0 ] !~ m/^File: no file / ) {
168 warn "File $f is already known in your CVS checkout -- perhaps it has been added by another user. Or this may indicate that it exists on a different branch. If this is the case, use -f to force the merge. \n " ;
169 warn "Status was: $status [0] \n " ;
173 foreach my $f ( @files ) {
174 next if grep { $_ eq $f } @afiles ;
175 # TODO:we need to handle removed in cvs
176 my @status = grep ( m/^File/ , safe_pipe_capture
( 'cvs' , '-q' , 'status' , $f ));
177 if ( @status > 1 ) { warn 'Strange! cvs status returned more than one line?' };
178 unless ( $status [ 0 ] =~ m/Status: Up-to-date$/ ) {
180 warn "File $f not up to date in your CVS checkout! \n " ;
184 if ( $opt_f ) { warn "The tree is not clean -- forced merge \n " ;
187 die "Exiting: your CVS tree is not clean for this merge." ;
192 `GIT_DIR= git-apply -C $fuzz --binary --summary --numstat --apply <.cvsexportcommit.diff` || die "cannot patch" ;
194 print "Patch applied successfully. Adding new files and directories to CVS \n " ;
196 foreach my $d ( @dirs ) {
197 if ( system ( 'cvs' , 'add' , $d )) {
199 warn "Failed to cvs add directory $d -- you may need to do it manually" ;
203 foreach my $f ( @afiles ) {
204 if ( grep { $_ eq $f } @bfiles ) {
205 system ( 'cvs' , 'add' , '-kb' , $f );
207 system ( 'cvs' , 'add' , $f );
211 warn "Failed to cvs add $f -- you may need to do it manually" ;
215 foreach my $f ( @dfiles ) {
216 system ( 'cvs' , 'rm' , '-f' , $f );
219 warn "Failed to cvs rm -f $f -- you may need to do it manually" ;
223 print "Commit to CVS \n " ;
224 print "Patch title (first comment line): $title \n " ;
225 my @commitfiles = map { unless ( m/\s/ ) { ' \' ' . $_ . ' \' ' ; } else { $_ ; }; } ( @files );
226 my $cmd = "cvs commit -F .msg @commitfiles " ;
229 print "NOTE: One or more hunks failed to apply cleanly. \n " ;
230 print "You'll need to apply the patch in .cvsexportcommit.diff manually \n " ;
231 print "using a patch program. After applying the patch and resolving the \n " ;
232 print "problems you may commit using:" ;
238 print "Autocommit \n $cmd \n " ;
239 print safe_pipe_capture
( 'cvs' , 'commit' , '-F' , '.msg' , @files );
241 die "Exiting: The commit did not succeed" ;
243 print "Committed successfully to CVS \n " ;
245 print "Ready for you to commit, just run: \n\n $cmd \n " ;
249 unlink ( ".cvsexportcommit.diff" );
254 Usage: GIT_DIR=/path/to/.git ${ \b asename $0 } [-h] [-p] [-v] [-c] [-f] [-m msgprefix] [ parent ] commit
259 # An alternative to `command` that allows input to be passed as an array
260 # to work around shell problems with weird characters in arguments
261 # if the exec returns non-zero we die
262 sub safe_pipe_capture
{
264 if ( my $pid = open my $child , '-|' ) {
265 @output = (< $child >);
266 close $child or die join ( ' ' , @_ ). ": $! $?" ;
268 exec ( @_ ) or die "$! $?" ; # exec() can fail the executable can't be found
270 return wantarray ?
@output : join ( '' , @output );
273 sub safe_pipe_capture_blob
{
275 if ( my $pid = open my $child , '-|' ) {
278 $output = (< $child >);
279 close $child or die join ( ' ' , @_ ). ": $! $?" ;
281 exec ( @_ ) or die "$! $?" ; # exec() can fail the executable can't be found