Alt-App-makepatch

 view release on metacpan or  search on metacpan

script/applypatch  view on Meta::CPAN

    # (like MSWin32) do not allow directories to be stamped.
    utime ($mtime, $mtime, $fn)
      || -d $fn || warn ("WARNING: utime($mtime,$fn): $!\n");
    printf STDERR ("+ chmod 0%o $fn\n", $mode) if $trace;
    chmod ($mode, $fn)
      || warn sprintf ("WARNING: Cannot utime/chmod 0%o $fn: $!\n", $mode);
}

sub do_unlink ($) {
    my ($fn) = @_;
    my $mode = (stat($fn))[2];
    chmod (0777, $fn)
      || warn ("WARNING: Cannot unlink/chmod a+rwx $fn: $!\n");
    print STDERR ("+ unlink $fn\n") if $verbose;
    return if unlink ($fn);
    warn ("WARNING: Cannot remove $fn: $!\n");
    chmod ($mode, $fn)
      || warn sprintf ("WARNING: Cannot unlink/chmod 0%o $fn: $!\n", $mode);
}

sub do_rmdir ($) {
    my ($fn) = @_;
    my $mode = (stat($fn))[2];
    chmod (0777, $fn)
      || warn ("WARNING: Cannot rmdir/chmod a+rwx $fn: $!\n");
    print STDERR ("+ rmdir $fn\n") if $verbose;
    return if rmdir ($fn);
    warn ("WARNING: Cannot rmdir $fn: $!\n");
    chmod ($mode, $fn)
      || warn sprintf ("WARNING: Cannot rmdir/chmod 0%o $fn: $!\n", $mode);
}

sub post_patch () {

script/makepatch  view on Meta::CPAN

    # This will bail out if the directory could not be created.
    $patch->open(">$thepatch") || die ("$thepatch: $!\n");
    binmode($patch);

    if ( -f $old->{root} && -f $new->{root} ) {
	# Two files.
	verbose ("Old file = $old->{root}.\n", "New file = $new->{root}.\n");
	dodiff ($dot, $new->{root}, $dot, $old->{root}) &&
	  push (@workq, [ 'p', $old->{root}, -s $old->{root},
			  (stat($new->{root}))[9], (stat(_))[2] ]);
    }
    elsif ( -f $old->{root} && -d $new->{root} ) {
	# File and dir -> File and dir/File.
	$new->{root} = $new->{base} = catfile ($new->{root}, $old->{root});
        verbose ("Old file = $old->{root}.\n", "New file = $new->{root}.\n");
	if ( -f $new->{root} ) {
	    dodiff ($dot, $new->{root}, $dot, $old->{root}) &&
	      push (@workq, [ 'p', $old->{root}, -s $old->{root},
			      (stat($new->{root}))[9], (stat(_))[2] ]);
	}
	else {
	    unshift (@workq, [ 'r', $old->{root}, -s $old->{root}, 0 ]);
	}
    }
    elsif ( -d $old->{root} && -f $new->{root} ) {
	# Dir and file -> Dir/file and file.
	$old->{root} = $old->{base} = catfile ($old->{root}, $new->{root});
        verbose ("Old file = $old->{root}.\n", "New file = $new->{root}.\n");
	if ( -f $old->{root} ) {
	    dodiff ($dot, $new->{root}, $dot, $old->{root}) &&
	      push (@workq, [ 'p', $old->{root}, -s $old->{root},
			      (stat($new->{root}))[9], (stat(_))[2] ]);
	}
	else {
	    newfile ($new->{root}, $old->{root}) &&
	      push (@workq, [ 'c', $old->{root}, 0,
			      (stat($new->{root}))[9], (stat(_))[2] ]);
	}
    }
    elsif ( -d $old->{root} && -d $new->{root} ) {
	# Two directories.
	if ( $opt_nomanifest ) {
	    verbose ("Not using MANIFEST files.\n");
	    undef $opt_oldmanifest;
	    undef $opt_newmanifest;
	}
	elsif ( defined $opt_automanifest &&

script/makepatch  view on Meta::CPAN

	    my $oldpl = catfile ($old->{root}, $opt_patchlevel);
	    my $newpl = catfile ($new->{root}, $opt_patchlevel);
	    if ( ! -f $newpl ) {
		die ("$newpl: $!\n");
	    }
	    if ( -f $oldpl ) {
		push (@workq, [ dodiff ($new->{root}, $opt_patchlevel,
					$old->{root}, $opt_patchlevel) ? 'p' : 'v',
				$opt_patchlevel,
				-s $oldpl,
				(stat($newpl))[9], (stat(_))[2] ]);
		# Remove patchlevel.h from the list of old files.
		$old->{files} = [ grep ($_ ne $opt_patchlevel, @{$old->{files}}) ];
	    }
	    else {
		newfile ($new->{root}, $opt_patchlevel) &&
		  push (@workq, [ 'c', $opt_patchlevel, 0,
				  (stat($newpl))[9], (stat(_))[2] ]);
	    }
	    # Remove patchlevel.h from the list of new files.
	    $new->{files} = [ grep ($_ ne $opt_patchlevel, @{$new->{files}}) ];
	}
	else {
	    undef $opt_patchlevel;
	}

        my $o;
        my $n;

script/makepatch  view on Meta::CPAN

	    $o = shift (@{$old->{files}}) unless defined $o;
	    $n = shift (@{$new->{files}}) unless defined $n;

	    debug ("* ", $o || "(undef)", " <-> ", $n || "(undef)", " ",
		   "* $old->{files}->[0] <-> $new->{files}->[0]\n") if $opt_debug;
	    if ( defined $n && (!defined $o || $o gt $n) ) {
		# New file.
		debug ("*> New file: $n\n");
		newfile ($new->{root}, $n) &&
		  push (@workq, [ 'c', $n, 0,
				  (stat(catfile($new->{root},$n)))[9],
				  (stat(_))[2] ]);
		undef $n;
	    }
	    elsif ( !defined $n || $o lt $n ) {
		# Obsolete (removed) file.
		debug ("*> Obsolete: $o\n");
		unshift (@workq, [ 'r', $o, -s catfile($old->{root},$o), 0 ]);
		undef $o;
	    }
	    elsif ( $o eq $n ) {
		# Same file.
		debug ("*> Compare: $n\n");
		dodiff ($new->{root}, $n, $old->{root}, $o) &&
		  push (@workq, [ 'p', $o, -s catfile($old->{root},$o),
				  (stat(catfile($new->{root},$n)))[9],
				  (stat(_))[2] ]);
		undef $n;
		undef $o;
	    }
	}
    }
    else {
	$patch->close;
	app_usage (1);
    }

script/makepatch  view on Meta::CPAN

    }
    unless ( $found ) {
	die ("ALARM: No patch data found for $old\n",
	     "Something is wrong with your diff command \"$opt_diff\".\n",
	     "It should produce context or unified diff output.\n");
    }

    # Replace patch header.
    if ( $unified ) {
	print $patch ("--- ", dot_file_u($old),
		      "\t" . localtime((stat($oldfn))[9]), "\n",
		      "+++ ", dot_file_u($new),
		      "\t" . localtime((stat($newfn))[9]), "\n",
		      $_);
    }
    else {
	print $patch ("*** ", dot_file_u($old),
		      "\t" . localtime((stat($oldfn))[9]), "\n",
		      "--- ", dot_file_u($new),
		      "\t" . localtime((stat($newfn))[9]), "\n",
		      $_);
    }

    # Copy rest.
    print $patch ($_) while <$fh>;
    print "\n";			# just in case
    $fh->close;

    return 1;
}

script/makepatch  view on Meta::CPAN

    # Prepending $dot, so we can use 'patch -p0' as well as 'patch -p1'.
    $new = dot_file_u($new);

    print $patch ("Index: $new\n");

    $lines = "1,$lines" unless $lines == 1;

    if ( $unified ) {
	print $patch ("--- ", $new, "\t" . localtime(0), "\n",
		      "+++ ", $new, "\t" . localtime((stat($fh))[9]), "\n",
		      "\@\@ -0,0 +", $lines, " \@\@\n");
	while ( <$fh> ) {
	    print $patch ("+$_");
	}
    }
    else {
	print $patch ("*** ", $new, "\t" . localtime(0), "\n",
		      "--- ", $new, "\t" . localtime((stat($fh))[9]), "\n",
		      "***************\n",
		      "*** 0 ****\n",
		      "--- ", $lines, " ----\n");
	while ( <$fh> ) {
	    print $patch ("+ $_");
	}
    }

    $fh->close;
    return 1;

script/makepatch  view on Meta::CPAN

	    # can handle creating new files.
	    # Create intermediate directories first.
	    # WARNING: This code assumes you are running some Unix.
	    my @p = split (/\//, $_);
	    pop (@p);
	    foreach my $i ( 0..(@p-1) ) {
		my $dir = join('/',@p[0..$i]);
		unless ( defined $dir_ok{$dir} ) {
		    unless ( -d catfile($old->{root},$dir) ) {
			push (@workq, [ 'C', $dir, 0,
					(stat(catfile($new->{root},$dir)))[9],
					(stat(_))[2] ]);
			$dcreated++;
		    }
		    $dir_ok{$dir} = 1;
		}
	    }
	}
    }

    my $fh = new IO::File;
    $fh->open(">$tmpfile") || die ("$tmpfile: $!\n");