App-SimpleBackuper

 view release on metacpan or  search on metacpan

lib/App/SimpleBackuper/DB/FilesTable.pm  view on Meta::CPAN

		$find_by_parent_id_name_cache_parent_id = $parent_id;
	}
	
	return $find_by_parent_id_name_cache{ $name };
}

sub delete {
	my $self = shift;
	%find_by_parent_id_name_cache = ();
	$find_by_parent_id_name_cache_parent_id = 0;
	return $self->SUPER::delete(@_);
}

1;

local/lib/perl5/Module/Build/API.pod  view on Meta::CPAN


This method returns a hash reference of metadata that can be used to create a
YAML datastream. It is provided for authors to override or customize the fields
of F<META.yml>.   E.g.

  package My::Builder;
  use base 'Module::Build';

  sub get_metadata {
    my $self, @args = @_;
    my $data = $self->SUPER::get_metadata(@args);
    $data->{custom_field} = 'foo';
    return $data;
  }

Valid arguments include:

=over

=item *

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


  # Build.PL
  use Module::Build;
  my $class = Module::Build->subclass(
      class => "Module::Build::Custom",
      code => <<'SUBCLASS' );

  sub ACTION_install {
      my $self = shift;
      # YOUR CODE HERE
      $self->SUPER::ACTION_install;
  }
  SUBCLASS

  $class->new(
      module_name => 'Your::Module',
      # rest of the usual Module::Build parameters
  )->create_build_script;


=head2 Adding an action

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

$VERSION = eval $VERSION;
use Module::Build::Base;
our @ISA = qw(Module::Build::Base);

use ExtUtils::Install;

sub have_forkpipe { 0 }

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);

  # $Config{sitelib} and $Config{sitearch} are, unfortunately, missing.
  foreach ('sitelib', 'sitearch') {
    $self->config($_ => $self->config("install$_"))
      unless $self->config($_);
  }

  # For some reason $Config{startperl} is filled with a bunch of crap.
  (my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//;
  $self->config(startperl => $sp);

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

    my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list);
    return unless defined $cmd;
    $cmd =~ s/ \*$//;
    $ARGV[0] = ($cmd);

    my $args = MacPerl::Ask('Any extra arguments?  (ie. verbose=1)', '');
    return unless defined $args;
    push @ARGV, $self->split_like_shell($args);
  }

  $self->SUPER::dispatch(@_);
}

sub ACTION_realclean {
  my $self = shift;
  chmod 0666, $self->{properties}{build_script};
  $self->SUPER::ACTION_realclean;
}

# ExtUtils::Install has a hard-coded '.' directory in versions less
# than 1.30.  We use a sneaky trick to turn that into ':'.
#
# Note that we do it here in a cross-platform way, so this code could
# actually go in Module::Build::Base.  But we put it here to be less
# intrusive for other platforms.

sub ACTION_install {
  my $self = shift;

  return $self->SUPER::ACTION_install(@_)
    if eval {ExtUtils::Install->VERSION('1.30'); 1};

  local $^W = 0; # Avoid a 'redefine' warning
  local *ExtUtils::Install::find = sub {
    my ($code, @dirs) = @_;

    @dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs;

    return File::Find::find($code, @dirs);
  };

  return $self->SUPER::ACTION_install(@_);
}

1;
__END__

=head1 NAME

Module::Build::Platform::MacOS - Builder class for MacOS platforms

=head1 DESCRIPTION

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

  # question "can I execute this file", but I think we want "is this
  # file executable".

  my ($self, $file) = @_;
  return +(stat $file)[2] & 0100;
}

sub _startperl { "#! " . shift()->perl }

sub _construct {
  my $self = shift()->SUPER::_construct(@_);

  # perl 5.8.1-RC[1-3] had some broken %Config entries, and
  # unfortunately Red Hat 9 shipped it like that.  Fix 'em up here.
  my $c = $self->{config};
  for (qw(siteman1 siteman3 vendorman1 vendorman3)) {
    $c->{"install${_}dir"} ||= $c->{"install${_}"};
  }

  return $self;
}

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

=over 4

=item _set_defaults

Change $self->{build_script} to 'Build.com' so @Build works.

=cut

sub _set_defaults {
    my $self = shift;
    $self->SUPER::_set_defaults(@_);

    $self->{properties}{build_script} = 'Build.com';
}


=item cull_args

'@Build foo' on VMS will not preserve the case of 'foo'.  Rather than forcing
people to write '@Build "foo"' we'll dispatch case-insensitively.

=cut

sub cull_args {
    my $self = shift;
    my($action, $args) = $self->SUPER::cull_args(@_);
    my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;

    die "Ambiguous action '$action'.  Could be one of @possible_actions"
        if @possible_actions > 1;

    return ($possible_actions[0], $args);
}


=item manpage_separator

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

    my ($self, $command) = @_;

    # a lot of VMS executables have a symbol defined
    # check those first
    if ( $^O eq 'VMS' ) {
        require VMS::DCLsym;
        my $syms = VMS::DCLsym->new;
        return $command if scalar $syms->getsym( uc $command );
    }

    $self->SUPER::find_command($command);
}

# _maybe_command copied from ExtUtils::MM_VMS::maybe_command

=item _maybe_command (override)

Follows VMS naming conventions for executable files.
If the name passed in doesn't exactly match an executable file,
appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
to check for DCL procedure.  If this fails, checks directories in DCL$PATH

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

}

=item oneliner

Override to ensure that we do not quote the command.

=cut

sub oneliner {
    my $self = shift;
    my $oneliner = $self->SUPER::oneliner(@_);

    $oneliner =~ s/^\"\S+\"//;

    return "MCR $^X $oneliner";
}

=item rscan_dir

Inherit the standard version but remove dots at end of name.
If the extended character set is in effect, do not remove dots from filenames
with Unix path delimiters.

=cut

sub rscan_dir {
  my ($self, $dir, $pattern) = @_;

  my $result = $self->SUPER::rscan_dir( $dir, $pattern );

  for my $file (@$result) {
      if (!_efs() && ($file =~ m#/#)) {
          $file =~ s/\.$//;
      }
  }
  return $result;
}

=item dist_dir

Inherit the standard version but replace embedded dots with underscores because
a dot is the directory delimiter on VMS.

=cut

sub dist_dir {
  my $self = shift;

  my $dist_dir = $self->SUPER::dist_dir;
  $dist_dir =~ s/\./_/g unless _efs();
  return $dist_dir;
}

=item man3page_name

Inherit the standard version but chop the extra manpage delimiter off the front if
there is one.  The VMS version of splitdir('[.foo]') returns '', 'foo'.

=cut

sub man3page_name {
  my $self = shift;

  my $mpname = $self->SUPER::man3page_name( shift );
  my $sep = $self->manpage_separator;
  $mpname =~ s/^$sep//;
  return $mpname;
}

=item expand_test_dir

Inherit the standard version but relativize the paths as the native glob() doesn't
do that for us.

=cut

sub expand_test_dir {
  my ($self, $dir) = @_;

  my @reldirs = $self->SUPER::expand_test_dir( $dir );

  for my $eachdir (@reldirs) {
    my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
    my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
    $eachdir = File::Spec->catfile( $reldir, $f );
  }
  return @reldirs;
}

=item _detildefy

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

sub _detildefy {
  my ($self, $value) = @_;
  $value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x
    if $ENV{HOME};
  return $value;
}

sub ACTION_realclean {
  my ($self) = @_;

  $self->SUPER::ACTION_realclean();

  my $basename = basename($0);
  $basename =~ s/(?:\.bat)?$//i;

  if ( lc $basename eq lc $self->build_script ) {
    if ( $self->build_bat ) {
      $self->log_verbose("Deleting $basename.bat\n");
      my $full_progname = $0;
      $full_progname =~ s/(?:\.bat)?$/.bat/i;

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

      close $fh ;
    } else {
      $self->delete_filetree($self->build_script . '.bat');
    }
  }
}

sub make_executable {
  my $self = shift;

  $self->SUPER::make_executable(@_);

  foreach my $script (@_) {

    # Native batch script
    if ( $script =~ /\.(bat|cmd)$/ ) {
      $self->SUPER::make_executable($script);
      next;

    # Perl script that needs to be wrapped in a batch script
    } else {
      my %opts = ();
      if ( $script eq $self->build_script ) {
        $opts{ntargs}    = q(-x -S %0 --build_bat %*);
        $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9);
      }

      my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)};
      if ( $@ ) {
        $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@");
      } else {
        $self->SUPER::make_executable($out);
      }
    }
  }
}

sub pl2bat {
  my $self = shift;
  my %opts = @_;
  require ExtUtils::PL2Bat;
  return ExtUtils::PL2Bat::pl2bat(%opts);

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

# from C<ExtUtils::MM_Unix>.

sub _maybe_command {
    my ($self, $file) = @_;

    if ($file =~ m{^/cygdrive/}i) {
        require Module::Build::Platform::Windows;
        return Module::Build::Platform::Windows->_maybe_command($file);
    }

    return $self->SUPER::_maybe_command($file);
}

1;
__END__


=head1 NAME

Module::Build::Platform::cygwin - Builder class for Cygwin platform

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


package Net::SFTP::Foreign::FileHandle;
our @ISA = qw(Net::SFTP::Foreign::Handle IO::File);

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift;

    my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, '', '');
}

sub _check_is_file {}

sub _bin { \(*{shift()}{ARRAY}[4]) }
sub _bout { \(*{shift()}{ARRAY}[5]) }

sub WRITE {
    my ($self, undef, $length, $offset) = @_;
    $self->_check

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


package Net::SFTP::Foreign::DirHandle;
our @ISA = qw(Net::SFTP::Foreign::Handle IO::Dir);

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift;

    my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, []);
}


sub _check_is_dir {}

sub _cache { *{shift()}{ARRAY}[4] }

*CLOSEDIR = $gen_proxy_method->('closedir');
*READDIR = $gen_proxy_method->('_readdir');

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

my @fields = qw( flags size uid gid perm atime mtime );

for my $f (@fields) {
    no strict 'refs';
    *$f = sub { @_ > 1 ? $_[0]->{$f} = $_[1] : $_[0]->{$f} || 0 }
}

sub new {
    my ($class, %param) = @_;

    my $a = $class->SUPER::new();

    if (my $stat = $param{Stat}) {
	$a->set_size($stat->[7]);
	$a->set_ugid($stat->[4], $stat->[5]);
	$a->set_perm($stat->[2]);
	$a->set_amtime($stat->[8], $stat->[9]);
    }
    $a;
}

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


BEGIN {
    my @forbidden = qw( setcwd cwd open opendir sftpread sftpwrite
                        seek tell eof write flush read getc lstat stat
                        fstat remove rmdir mkdir setstat fsetstat
                        close closedir readdir realpath readlink
                        rename symlink abort get_content join glob
                        rremove rget rput error die_on_error );

    for my $method (@forbidden) {
        my $super = "SUPER::$method";
        no strict 'refs';
        *{$method} = sub {
            unless (index((caller)[0], "Net::SFTP::Foreign") == 0) {
                croak "Method '$method' is not available from " . __PACKAGE__
                    . ", use the real Net::SFTP::Foreign if you want it!";
            }
            shift->$super(@_);
        };
    }
}

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

    my ($class, $host, %opts) = @_;

    my $warn;
    if (exists $opts{warn}) {
	$warn = delete($opts{warn}) || sub {};
    }
    else {
	$warn = sub { warn(CORE::join '', @_, "\n") };
    }

    my $sftp = $class->SUPER::new($host, @{$DEFAULTS{new}}, %opts);

    $sftp->{_compat_warn} = $warn;

    return $sftp;

}

sub _warn {
    my $sftp = shift;
    if (my $w = $sftp->{_compat_warn}) {
	$w->(@_);
    }
}

sub _warn_error {
    my $sftp = shift;
    if (my $e = $sftp->SUPER::error) {
	$sftp->_warn($e);
    }
}

sub status {
    my $status = shift->SUPER::status;
    return wantarray ? ($status + 0, "$status") : $status + 0;
}

sub get {
    croak '$Usage: $sftp->get($local, $remote, $cb)' if @_ < 2 or @_ > 4;
    my ($sftp, $remote, $local, $cb) = @_;

    my $save = defined(wantarray);
    my @content;
    my @cb;
    if (defined $cb or $save) {
        @cb = ( callback => sub {
                    my ($sftp, $data, $off, $size) = @_;
                    $cb->($sftp, $data, $off, $size) if $cb;
                    push @content, $data if $save
                });
    }

    $sftp->SUPER::get($remote, $local,
                      @{$DEFAULTS{get}},
                      dont_save => !defined($local),
                      @cb)
        or return undef;

    if ($save) {
	return CORE::join('', @content);
    }
}

sub put {
    croak '$Usage: $sftp->put($local, $remote, $cb)' if @_ < 3 or @_ > 4;
    my ($sftp, $local, $remote, $cb) = @_;

    $sftp->SUPER::put($local, $remote,
                      @{$DEFAULTS{put}},
		      callback => $cb);
    $sftp->_warn_error;
    !$sftp->SUPER::error;
}

sub ls {
    croak '$Usage: $sftp->ls($path, $cb)' if @_ < 2 or @_ > 3;
    my ($sftp, $path, $cb) = @_;
    if ($cb) {
	$sftp->SUPER::ls($path,
                         @{$DEFAULTS{ls}},
			 wanted => sub { _rebless_attrs($_[1]->{a});
					 $cb->($_[1]);
					 0 } );
	return ();
    }
    else {
	if (my $ls = $sftp->SUPER::ls($path, @{$DEFAULTS{ls}})) {
	    _rebless_attrs($_->{a}) for @$ls;
	    return @$ls;
	}
	return ()
    }
}

sub do_open { shift->SUPER::open(@_) }

sub do_opendir { shift->SUPER::opendir(@_) }

sub do_realpath { shift->SUPER::realpath(@_) }

sub do_read {
    my $sftp = shift;
    my $read = $sftp->SUPER::sftpread(@_);
    $sftp->_warn_error;
    if (wantarray) {
	return ($read, $sftp->status);
    }
    else {
	return $read
    }
}

sub _gen_do_and_status {
    my $method = "SUPER::" . shift;
    return sub {
	my $sftp = shift;
	$sftp->$method(@_);
	$sftp->_warn_error;
	$sftp->status;
    }
}

*do_write = _gen_do_and_status('sftpwrite');
*do_close = _gen_do_and_status('close');

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

    if ($a) {
	bless $a,  ( $supplant
		     ? "Net::SFTP::Attributes"
		     : "Net::SFTP::Foreign::Attributes::Compat" );
    }
    $a;
}

sub _gen_do_stat {
    my $name = shift;
    my $method = "SUPER::$name";
    return sub {
        croak '$Usage: $sftp->'.$name.'($local, $remote, $cb)' if @_ != 2;
	my $sftp = shift;
	if (my $a = $sftp->$method(@_)) {
	    return _rebless_attrs($a);
	}
	else {
	    $sftp->_warn_error;
	    return undef;
	}

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

  my $exp = [ ($self->{val}) x @$got ];

  return Test::Deep::descend($got, $exp);
}

sub renderExp
{
  my $self = shift;
  my $exp = shift;

  return '[ ' . $self->SUPER::renderExp($self->{val}) . ', ... ]';
}

1;

__END__

=pod

=encoding UTF-8

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


  return "blessed($var)"
}

sub renderGot
{
  my $self = shift;

  my $got = shift;

  $self->SUPER::renderGot(blessed($got));
}

1;

__END__

=pod

=encoding UTF-8

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

use strict;
use warnings;

package Test::Deep::Ignore 1.204;

use Test::Deep::Cmp;

my $Singleton = __PACKAGE__->SUPER::new;

sub new
{
  return $Singleton;
}

sub descend
{
  return 1;
}

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

use warnings;

package Test::Deep::ListMethods 1.204;

use base 'Test::Deep::Methods';

sub call_method
{
  my $self = shift;

  return [$self->SUPER::call_method(@_)];
}

sub render_stack
{
  my $self = shift;

  my $var = $self->SUPER::render_stack(@_);

  return "[$var]";
}

1;

__END__

=pod

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

}

sub renderGot
{
  my $self = shift;
  my $val = shift;

  my $got_string = $self->data->{got_string};
  if ("$val" ne "$got_string")
  {
    $got_string = $self->SUPER::renderGot($got_string);
    return "$val ($got_string)"
  }
  else
  {
    return $val;
  }
}
sub renderExp
{
  my $self = shift;

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


  return "reftype($var)";
}

sub renderGot
{
  my $self = shift;

  my $got = shift;

  $self->SUPER::renderGot(reftype($got));
}

1;

__END__

=pod

=encoding UTF-8

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


sub render_stack
{
  my $self = shift;

  my $stack = shift;

  $stack = "[$stack =~ $self->{regex}]";

  return $stack;
#  return $self->SUPER::render_stack($stack);
}

sub reset_arrow
{
  return 1;
}

1;

__END__

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


use Carp qw( confess );
use Scalar::Util;

use Test::Deep::MM qw( new init Stack Arrow );

sub init
{
  my $self = shift;

  $self->SUPER::init(@_);

  $self->setStack([]) unless $self->getStack;
}

sub push
{
  my $self = shift;

  push(@{$self->getStack}, @_);
}

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


{
  package Test::Spec::Mocks::Stub;
  use base qw(Test::Spec::Mocks::Expectation);

  # A stub is a special case of expectation that doesn't actually
  # expect anything.

  sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->at_least(0);
    return $self;
  }

}

1;

=head1 NAME



( run in 2.346 seconds using v1.01-cache-2.11-cpan-a9ef4e587e4 )