App-SimpleBackuper

 view release on metacpan or  search on metacpan

local/lib/perl5/Module/Build/PPMMaker.pm  view on Meta::CPAN

  $ppd .= <<'EOF';
    </IMPLEMENTATION>
</SOFTPKG>
EOF

  my $ppd_file = "$dist{name}.ppd";
  open(my $fh, '>', $ppd_file)
    or die "Cannot write to $ppd_file: $!";

  binmode($fh, ":utf8")
    if $] >= 5.008 && $Config{useperlio};
  print $fh $ppd;
  close $fh;

  return $ppd_file;
}

sub _ppd_version {
  my ($self, $version) = @_;

local/lib/perl5/Module/Build/PodParser.pm  view on Meta::CPAN

  return $self;
}

sub parse_from_filehandle {
  my ($self, $fh) = @_;

  local $_;
  while (<$fh>) {
    next unless /^ =encoding \s+ (\S+)/ix;
    binmode $fh, ":encoding($1)";
    last;
  }
  seek $fh, 0, 0;

  while (<$fh>) {
    next unless /^=(?!cut)/ .. /^=cut/;  # in POD
    # Accept Name - abstract or C<Name> - abstract
    last if ($self->{abstract}) = /^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix;
  }

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

        if ($atomic) {
            $atomic_local = $local;
            $local .= sprintf("(%d).tmp", rand(10000));
            $atomic_numbered = $numbered;
            $numbered = 1;
            $debug and $debug & 128 and _debug("temporal local file name: $local");
        }

        if ($resume) {
            if (CORE::open $fh, '+<', $local) {
                binmode $fh;
		CORE::seek($fh, 0, 2);
                $askoff = CORE::tell $fh;
                if ($askoff < 0) {
                    # something is going really wrong here, fall
                    # back to non-resuming mode...
                    $askoff = 0;
                    undef $fh;
                }
                else {
                    if ($size >=0 and $askoff > $size) {

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

                while (1) {
                    sysopen ($fh, $local, $flags, $open_perm) and last;
                    unless ($numbered and -e $local) {
                        $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
                                          "Can't open $local", $!);
                        return undef;
                    }
                    _inc_numbered($local);
                }
                $$numbered = $local if ref $numbered;
		binmode $fh;
		$lstart = sysseek($fh, 0, 2) if $append;
	    }
	}

	if (defined $perm) {
            my $error;
	    do {
                local ($@, $SIG{__DIE__}, $SIG{__WARN__});
                unless (eval { CORE::chmod($perm, $local) > 0 }) {
                    $error = ($@ ? $@ : $!);

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

	$neg_umask = $perm;
    }
    else {
	$umask = umask unless defined $umask;
	$neg_umask = 0777 & ~$umask;
    }

    my ($fh, $lmode, $lsize, $latime, $lmtime);
    if ($local_is_fh) {
	$fh = $local;
	# we don't set binmode for the passed file handle on purpose
    }
    else {
	unless (CORE::open $fh, '<', $local) {
	    $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
			      "Unable to open local file '$local'", $!);
	    return undef;
	}
	binmode $fh;
    }

    {
	# as $fh can come from the outside, it may be a tied object
	# lacking support for some methods, so we call them wrapped
	# inside eval blocks
	local ($@, $SIG{__DIE__}, $SIG{__WARN__});
	if ((undef, undef, $lmode, undef, undef,
	     undef, undef, $lsize, $latime, $lmtime) =
	    eval {

local/lib/perl5/Net/SFTP/Foreign.pm  view on Meta::CPAN

A file handle can also be passed in the C<$local> argument. In that
case, data is read from there and stored in the remote file. UTF8 data
is not supported unless a custom converter callback is used to
transform it to bytes. The method will croak if it encounters any data
in perl internal UTF8 format. Note also that the handle is not closed
when the transmission finish.

Example:

  binmode STDIN;
  $sftp->put(\*STDIN, "stdin.dat") or die "put failed";
  close STDIN;

This method accepts several options:

=over 4

=item copy_time =E<gt> $bool

determines if access and modification time attributes have to be

local/lib/perl5/Net/SFTP/Foreign/Backend/Unix.pm  view on Meta::CPAN

sub _new { shift }

sub _defaults {
   ( queue_size => 32 )
}

sub _init_transport_streams {
    my (undef, $sftp) = @_;
    for my $dir (qw(ssh_in ssh_out)) {
	binmode $sftp->{$dir};
	my $flags = fcntl($sftp->{$dir}, F_GETFL, 0);
	fcntl($sftp->{$dir}, F_SETFL, $flags | O_NONBLOCK);
    }
}

sub _open_dev_null {
    my $sftp = shift;
    my $dev_null;
    unless (open $dev_null, '>', "/dev/null") {
	$sftp->_conn_failed("Unable to redirect stderr to /dev/null");

local/lib/perl5/Net/SFTP/Foreign/Backend/Windows.pm  view on Meta::CPAN

require Net::SFTP::Foreign::Backend::Unix;
our @ISA = qw(Net::SFTP::Foreign::Backend::Unix);

sub _defaults {
    ( queue_size => 16 )
}

sub _init_transport_streams {
    my ($backend, $sftp) = @_;
    binmode $sftp->{ssh_in};
    binmode $sftp->{ssh_out};
}

sub _open_dev_null {
    my $sftp = shift;
    my $dev_null;
    unless (open $dev_null, '>', 'NUL:') {
	$sftp->_conn_failed("Unable to redirect stderr for slave SSH process to NUL: $!");
	return;
    }
    $dev_null

local/lib/perl5/Test/Trap.pm  view on Meta::CPAN

=head2 tempfile

The default capture strategy, provided by
L<Test::Trap::Builder::TempFile>, in which output is temporarily
redirected to (and read back from) a tempfile.

=head2 tempfile-preserve

A variant of the capture strategy provided by
L<Test::Trap::Builder::TempFile>, in which the handles used to write
to and read from the tempfile are both binmoded with the same perlio
layers as the trapped output handle originally had.

Caveat emptor: If the handle has perlio custom layers, they may (or
may not) fail to apply to the tempfile read and write handles.

=head2 systemsafe

A capture strategy provided by L<Test::Trap::Builder::SystemSafe>,
like the default strategy, except it outputs on file handles with the
same file descriptors as the trapped output handle originally had, and

local/lib/perl5/Test/Trap.pm  view on Meta::CPAN

descriptors being available after closing.  (If signal handlers or
threads open files, they may well not be.)  And it may fail in other
ways.  But in relation to forked-off processes, the other pre-defined
strategies will silently fail to trap, as will similarly simple
strategies.  This one, when not crashing, will trap that output.

=head2 systemsafe-preserve

A variant of the capture strategy provided by
L<Test::Trap::Builder::SystemSafe>, in which the handles used to write
to and read from the tempfile are both binmoded with the same perlio
layers as the trapped output handle originally had.

Caveat emptor: If the handle has perlio custom layers, they may (or
may not) fail to apply to the tempfile read and write handles.

=head2 perlio

A capture strategy provided by L<Test::Trap::Builder::PerlIO>, in
which output is temporarily redirected to an in-memory file via
PerlIO::scalar.

local/lib/perl5/Test/Trap/Builder/SystemSafe.pm  view on Meta::CPAN

                         close $fh_keeper;
                         sprintf "Cannot dup '%s' for %s: '%s'",
                           $fno, $name, $!;
                       },
                     );
        close $fh_keeper; # another potential leak, I suppose.
        $globref->autoflush($autoflush_keeper);
      IO_LAYERS: {
          GOTPERLIO or last IO_LAYERS;
          local($!, $^E);
          binmode *$globref;
          my @tmp = @restore_io_layers;
          $_ eq $tmp[0] ? shift @tmp : last for PerlIO::get_layers(*$globref);
          binmode *$globref, $_ for @tmp;
        }
      };
    }
    binmode $fh; # superfluous?
    {
      local ($!, $^E);
      open $fh_keeper, ">&$fileno"
        or $self->Exception("Cannot dup '$fileno' for $name: '$!'");
    }
  IO_LAYERS: {
      GOTPERLIO or last IO_LAYERS;
      local($!, $^E);
      @restore_io_layers = PerlIO::get_layers(*$globref, output => 1);
      if ($strategy_option->{preserve_io_layers}) {

local/lib/perl5/Test/Trap/Builder/SystemSafe.pm  view on Meta::CPAN

    _close_reopen( $self->ExceptionFunction, $globref, $fileno, ">>$file",
                   sub {
                     sprintf "Cannot open %s for %s: '%s'",
                       $file, $name, $!;
                   },
                 );
  IO_LAYERS: {
      GOTPERLIO or last IO_LAYERS;
      local($!, $^E);
      for my $h (*$globref, $fh) {
        binmode $h;
        my @tmp = @io_layers or next;
        $_ eq $tmp[0] ? shift @tmp : last for PerlIO::get_layers($h);
        binmode $h, $_ for @tmp;
      }
    }
    $globref->autoflush(1);
    $self->Next;
  };
}

sub _close_reopen {
  my ($Die, $glob, $fno_want, $what, $err) = @_;
  local ($!, $^E);

local/lib/perl5/Test/Trap/Builder/TempFile.pm  view on Meta::CPAN

    my @io_layers;
  IO_LAYERS: {
      GOTPERLIO or last IO_LAYERS;
      local($!, $^E);
      if ($strategy_option->{preserve_io_layers}) {
        @io_layers = PerlIO::get_layers(*$globref, output => 1);
      }
      if ($strategy_option->{io_layers}) {
        push @io_layers, $strategy_option->{io_layers};
      }
      binmode $fh; # set the perlio layers for reading:
      binmode $fh, $_ for @io_layers;
    }
    local *$globref;
    {
      no warnings 'io';
      local ($!, $^E);
      open *$globref, '>>', $file;
    }
  IO_LAYERS: {
      GOTPERLIO or last IO_LAYERS;
      local($!, $^E);
      binmode *$globref; # set the perlio layers for writing:
      binmode *$globref, $_ for @io_layers;
    }
    *$globref->autoflush(1);
    $self->Next;
  };
}

1; # End of Test::Trap::Builder::TempFile

__END__