view release on metacpan or  search on metacpan

script/applypatch  view on Meta::CPAN

    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");

script/applypatch  view on Meta::CPAN

		    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' ) {

script/makepatch  view on Meta::CPAN

# STEP 3: Run the 'patch' program with this file as input.
#
# These are the commands needed to create/delete files/directories:
#
EOD
	foreach ( @workq ) {
	    my ($op, $file, @args) = @$_;
	    if ( $op eq 'C' ) {
		print $fh ("mkdir ", quotfn($file), "\n");
		if ( defined $args[2] && ($args[2] &= 0777) ) {
		    printf $fh ("chmod 0%o %s\n", $args[2], quotfn($file))
		}
	    }
	}
	foreach ( @workq ) {
	    my ($op, $file, @args) = @$_;
	    if ( $op eq 'r' ) {
		print $fh ("rm -f ", quotfn($file), "\n");
	    }
	    elsif ( $op eq 'R' ) {
		print $fh ("rmdir ", quotfn($file), "\n");
	    }
	    elsif ( $op eq 'c' ) {
		print $fh ("touch ", quotfn($file), "\n");
		if ( defined $args[2] && ($args[2] &= 0777) ) {
		    printf $fh ("chmod 0%o %s\n", $args[2], quotfn($file))
		}
	    }
	}
	print $fh <<EOD;
#
# This command terminates the shell and need not be executed manually.
exit
#
EOD
    }