view release on metacpan or  search on metacpan

script/applypatch  view on Meta::CPAN

	    if ( defined $sz ) {
		if ( $sz != $args[0] ) {
		    warn ("Verify error: size of $fn should be $args[0], but is ",
			  "$sz.\n");
		    $fail = 1;
		}
	    }
	    else {
		warn ("Verify error: file $fn is missing.\n");
		$fail = 1;
	    }
	}
	elsif ( $op eq 'R' ) {
	    unless ( -d $fn ) {
		warn ("Verify error: directory $fn must be removed, ",
		      "but does not exist.\n");
		$fail = 1;
	    }
	}
    }

    if ( $fail ) {
	if ( $force ) {
	    warn ("WARNING: This does not look like expected source ",
		  "directory, continuing anyway.\n");
	}
	else {
	    warn ("Apparently this is not the expected source directory, ",
		  "aborting.\n");
	    die ("Use \"--force\" to override this.\n");
	}
    }

    print STDERR ("Source directory apparently okay.\n") if $verbose;
}

sub pre_patch () {

    foreach ( @workq ) {
	my ($op, $fn, $size, $mtime, $mode) = @$_;

	if ( $op eq 'C' ) {
	    $mode = oct($mode) & 0777;
	    $mode = 0777 unless $mode; # sanity
	    printf STDERR ("+ mkpath $fn 0%o\n", $mode) if $trace;
	    mkdir ($fn, $mode) 
	      || die ("Cannot create directory $fn: $!\n");
	}
    }

    foreach ( @workq ) {
	my ($op, $fn, $size, $mtime, $mode) = @$_;

	if ( $op eq 'c' ) {
	    #$mode = oct($mode) & 0777;
	    #$mode = 0666 unless $mode; # sanity
	    print STDERR ("+ create $fn\n") if $trace;
	    open (F, '>'.$fn)
	      || die ("Cannot create $fn: $!\n");
	    close (F);
	    #printf STDERR ("+ chmod 0%o $fn\n", $mode) if $trace;
	    #chmod ($mode, $fn)
	    #  || warn sprintf ("WARNING: Cannot chmod 0%o $fn: $!\n", $mode);
	}
    }

}


sub _open_patch () {

	my $p = new IO::File;
	$p->open("|$patch") || die ("Cannot open pipe to \"$patch\": $!\n");
	binmode($p);

	return $p
}


sub execute_patch () {

	my $p;

    print STDERR ("+ $patch\n") if $trace;
    if ( $applypatch ) {
	my $lines = 0;
	while ( <$tmpfile> ) {
	    chomp;
	    print STDERR ("++ ", $_, "\n") if $debug;
	    next if $_ eq "#### Patch data follows ####";
	    last if $_ eq "#### End of Patch data ####";
	    $p = _open_patch() unless $p;
	    print $p ($_, "\n");
	    $lines++;
	}
	print STDERR ("+ $lines lines sent to \"$patch\"\n") if $trace;
    }
    else {
	    while ( <$tmpfile> ) {
		    $p = _open_patch() unless $p;
		    print $p ($_)
	    }
    }
	defined $p and
	  $p->close || die ("Possible problems with \"$patch\", status = $?.\n");
}

sub set_utime ($$;$) {
    my ($fn, $mtime, $mode) = @_;
    $mode = (stat ($fn))[2] unless defined $mode;
    chmod (0777, $fn)
      || warn ("WARNING: Cannot utime/chmod a+rwx $fn: $!\n");
    print STDERR ("+ utime $fn $mtime (".localtime($mtime).")\n") if $trace;
    # Set times. Ignore errors for directories since some systems
    # (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 () {

    my $suffix = $ENV{SIMPLE_BACKUP_SUFFIX} || ".orig";

    foreach ( @workq ) {
	my ($op, $fn, $size, $mtime, $mode) = @$_;

	if ( $op eq 'c' || $op eq 'C' || $op eq 'p' ) {
	    if ( defined $mode ) {
		$mode = oct($mode) & 0777;
		$mode = 0666 unless $mode; # sanity
	    }
	    set_utime ($fn, $mtime, $mode);
	    next if $retain;
	    $fn .= $suffix;
	    if ( -f $fn ) {
		do_unlink ($fn);
	    }
	}
	elsif ( $op eq 'r' ) {
	    print STDERR ("+ unlink $fn\n") if $trace;
	    # Be forgiving, maybe patch already removed the file.
	    if ( -e $fn ) {
		do_unlink ($fn);
	    }
	    else {
		warn ("Apparently, $fn has been removed already.\n");
	    }
	}
	elsif ( $op eq 'R' ) {
	    print STDERR ("+ rmdir $fn\n") if $trace;
	    # Maybe some future version of patch will take care of directories.
	    if ( -e $fn ) {
		do_rmdir ($fn);
	    }
	    else {
		warn ("Apparently, $fn has been removed already.\n");
	    }
	}
    }

}

################ Options and Help ################

sub app_options () {
    my $help = 0;		# handled locally

    # Process options, if any.
    # Make sure defaults are set before returning!
    return unless @ARGV > 0;
    my @opts = ('check'		=> \$check,
		'dir|d=s'	=> \$dir,
		'retain'	=> \$retain,
		'force'		=> \$force,
		'verbose'	=> \$verbose,
		'quiet'		=> sub { $verbose = 0; },
		'patch=s'	=> \$patch,