^sub \w+\( results from the CPAN

App-SimpleBackuper

use Const::Fast;
use App::SimpleBackuper::BackupDB;
use App::SimpleBackuper::_format;
use App::SimpleBackuper::_BlockDelete;
use App::SimpleBackuper::_BlocksInfo;

const my $SIZE_OF_TOP_FILES => 10;
const my $SAVE_DB_PERIOD => 60 * 60;
const my $PRINT_PROGRESS_PERIOD => 60;

sub _proc_uid_gid($$$) {
	my($uid, $gid, $uids_gids) = @_;
	
	my $last_uid_gid = @$uids_gids ? $uids_gids->unpack( $uids_gids->[-1] )->{id} : 0;
	
	my $user_name = getpwuid($uid);
	my($user) = grep { $_->{name} eq $user_name } map { $uids_gids->unpack($_) } @$uids_gids;
	if(! $user) {
		$user = {id => ++$last_uid_gid, name => $user_name};
		$uids_gids->upsert({ id => $user->{id} }, $user );
		#printf "new owner user added (unix uid %d, name %s, internal uid %d)\n", $uid, $user_name, $user->{id};

lib/App/SimpleBackuper/_BlocksInfo.pm view on Meta::CPAN

package App::SimpleBackuper;

use strict;
use warnings;

sub _BlocksInfo($$;$$$$);
sub _BlocksInfo($$;$$$$) {
	my($options, $state, $block_info, $parent_id, $path, $priority) = @_;
	
	$block_info //= {};
	$parent_id //= 0;
	$path //= '/';
	$priority //= 0;
	
	my($oldest_backup_id) = $state->{db}->{backups}->unpack($state->{db}->{backups}->[0])->{id};
	
	my $subfiles = $state->{db}->{files}->find_all({parent_id => $parent_id});

local/lib/perl5/Const/Fast.pm view on Meta::CPAN

}

use 5.008;
use strict;
use warnings FATAL => 'all';

use Scalar::Util qw/reftype blessed/;
use Carp qw/croak/;
use Sub::Exporter::Progressive 0.001007 -setup => { exports => [qw/const/], groups => { default => [qw/const/] } };

sub _dclone($) {
	require Storable;
	no warnings 'redefine';
	*_dclone = \&Storable::dclone;
	goto &Storable::dclone;
}

## no critic (RequireArgUnpacking, ProhibitAmpersandSigils)
# The use of $_[0] is deliberate and essential, to be able to use it as an lvalue and to keep the refcount down.

my %skip = map { $_ => 1 } qw/CODE GLOB/;

local/lib/perl5/Const/Fast.pm view on Meta::CPAN

		elsif ($reftype eq 'HASH') {
			&Internals::hv_clear_placeholders($_[0]);
			_make_readonly($_) for values %{ $_[0] };
		}
	}
	Internals::SvREADONLY($_[0], 1);
	return;
}

## no critic (ProhibitSubroutinePrototypes, ManyArgs)
sub const(\[$@%]@) {
	my (undef, @args) = @_;
	croak 'Invalid first argument, need an reference' if not defined reftype($_[0]);
	croak 'Attempt to reassign a readonly variable' if &Internals::SvREADONLY($_[0]);
	if (reftype $_[0] eq 'SCALAR' or reftype $_[0] eq 'REF') {
		croak 'No value for readonly variable' if @args == 0;
		croak 'Too many arguments in readonly assignment' if @args > 1;
		${ $_[0] } = $args[0];
	}
	elsif (reftype $_[0] eq 'ARRAY') {
		@{ $_[0] } = @args;

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

		}
	}
	if($errs ne "") {
		die "${errs}Can't continue after import errors ".
			"at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n";
	}
}

# Logic duplicated from Params::Classify.  Duplicating it here avoids
# an extensive and potentially circular dependency graph.
sub _is_string($) {
	my($arg) = @_;
	return defined($arg) && ref(\$arg) eq "SCALAR";
}

=head1 REGULAR EXPRESSIONS

These regular expressions do not include any anchors, so to check
whether an entire string matches a syntax item you must supply the
anchors yourself.

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


=over

=item is_module_name(ARG)

Returns a truth value indicating whether I<ARG> is a plain string
satisfying Perl module name syntax as described for L</$module_name_rx>.

=cut

sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o }

=item is_valid_module_name(ARG)

Deprecated alias for L</is_module_name>.

=cut

*is_valid_module_name = \&is_module_name;

=item check_module_name(ARG)

Check whether I<ARG> is a plain string
satisfying Perl module name syntax as described for L</$module_name_rx>.
Return normally if it is, or C<die> if it is not.

=cut

sub check_module_name($) {
	unless(&is_module_name) {
		die +(_is_string($_[0]) ? "`$_[0]'" : "argument").
			" is not a module name\n";
	}
}

=item module_notional_filename(NAME)

Generates a notional relative filename for a module, which is used in
some Perl core interfaces.

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

C<die>s.

The notional filename for the named module is generated and returned.
This filename is always in Unix style, with C</> directory separators
and a C<.pm> suffix.  This kind of filename can be used as an argument to
C<require>, and is the key that appears in C<%INC> to identify a module,
regardless of actual local filename syntax.

=cut

sub module_notional_filename($) {
	&check_module_name;
	my($name) = @_;
	$name =~ s!::!/!g;
	return $name.".pm";
}

=item require_module(NAME)

This is essentially the bareword form of C<require>, in runtime form.
The I<NAME> is a string, which should be a valid module name (one or

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

	*_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
}

BEGIN { if(_WORK_AROUND_BROKEN_MODULE_STATE) { eval q{
	sub Module::Runtime::__GUARD__::DESTROY {
		delete $INC{$_[0]->[0]} if @{$_[0]};
	}
	1;
}; die $@ if $@ ne ""; } }

sub require_module($) {
	# Localise %^H to work around [perl #68590], where the bug exists
	# and this is a satisfactory workaround.  The bug consists of
	# %^H state leaking into each required module, polluting the
	# module's lexical state.
	local %^H if _WORK_AROUND_HINT_LEAKAGE;
	if(_WORK_AROUND_BROKEN_MODULE_STATE) {
		my $notional_filename = &module_notional_filename;
		my $guard = bless([ $notional_filename ],
				"Module::Runtime::__GUARD__");
		my $result = CORE::require($notional_filename);

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

ensure that the version loaded is at least the version required.  This is
the same functionality provided by the I<VERSION> parameter of C<use>.

On success, the name of the module is returned.  This is unlike
L</require_module>, and is done so that the entire call to L</use_module>
can be used as a class name to call a constructor, as in the example in
the synopsis.

=cut

sub use_module($;$) {
	my($name, $version) = @_;
	require_module($name);
	$name->VERSION($version) if @_ >= 2;
	return $name;
}

=item use_package_optimistically(NAME[, VERSION])

This is an analogue of L</use_module> for the situation where there is
uncertainty as to whether a package/class is defined in its own module

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

2.20, and on both occasions this function changed to match.

If a I<VERSION> is specified, the C<VERSION> method of the loaded package is
called with the specified I<VERSION> as an argument.  This normally serves
to ensure that the version loaded is at least the version required.
On success, the name of the package is returned.  These aspects of the
function work just like L</use_module>.

=cut

sub use_package_optimistically($;$) {
	my($name, $version) = @_;
	my $fn = module_notional_filename($name);
	eval { local $SIG{__DIE__}; require_module($name); };
	die $@ if $@ ne "" &&
		($@ !~ /\ACan't locate \Q$fn\E .+ at \Q@{[__FILE__]}\E line/s ||
		 $@ =~ /^Compilation\ failed\ in\ require
			 \ at\ \Q@{[__FILE__]}\E\ line/xm);
	$name->VERSION($version) if @_ >= 2;
	return $name;
}

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

=item is_module_spec(PREFIX, SPEC)

Returns a truth value indicating
whether I<SPEC> is valid input for L</compose_module_name>.
See below for what that entails.  Whether a I<PREFIX> is supplied affects
the validity of I<SPEC>, but the exact value of the prefix is unimportant,
so this function treats I<PREFIX> as a truth value.

=cut

sub is_module_spec($$) {
	my($prefix, $spec) = @_;
	return _is_string($spec) &&
		$spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o :
				    qr/\A$top_module_spec_rx\z/o);
}

=item is_valid_module_spec(PREFIX, SPEC)

Deprecated alias for L</is_module_spec>.

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


*is_valid_module_spec = \&is_module_spec;

=item check_module_spec(PREFIX, SPEC)

Check whether I<SPEC> is valid input for L</compose_module_name>.
Return normally if it is, or C<die> if it is not.

=cut

sub check_module_spec($$) {
	unless(&is_module_spec) {
		die +(_is_string($_[1]) ? "`$_[1]'" : "argument").
			" is not a module specification\n";
	}
}

=item compose_module_name(PREFIX, SPEC)

This function is intended to make it more convenient for a user to specify
a Perl module name at runtime.  Users have greater need for abbreviations

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

separator, in addition to the standard C<::>.  The two separators are
entirely interchangeable.

Additionally, if I<PREFIX> is not C<undef> then it must be a module
name in standard form, and it is prefixed to the user-specified name.
The user can inhibit the prefix addition by starting I<SPEC> with a
separator (either C</> or C<::>).

=cut

sub compose_module_name($$) {
	my($prefix, $spec) = @_;
	check_module_name($prefix) if defined $prefix;
	&check_module_spec;
	if($spec =~ s#\A(?:/|::)##) {
		# OK
	} else {
		$spec = $prefix."::".$spec if defined $prefix;
	}
	$spec =~ s#/#::#g;
	return $spec;

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

  # of scope in a predictable fashion.
  %_Package_Tests = %_Package_Contexts = ();

  # XXX: this doesn't play nicely with Test::NoWarnings and friends
  $class->builder->done_testing;
}

# it DESC => CODE
# it CODE
# it DESC
sub it(@) {
  my $package = caller;
  my $code;
  if (@_ && ref($_[-1]) eq 'CODE') {
    $code = pop;
  }
  my $name = shift;
  if (not ($code || $name)) {
    Carp::croak "it() requires at least one of (description,code)";
  }
  $name ||= "behaves as expected (whatever that means)";
  push @{ _autovivify_context($package)->tests }, {
    name => $name,
    code => $code,
    todo => $TODO,
  };
  return;
}

# alias "they" to "it", for describing behavior of multiple items
sub they(@);
BEGIN { *they = \&it }

# describe DESC => CODE
# describe CODE
sub describe(@) {
  my $package = caller;
  my $code = pop;
  if (ref($code) ne 'CODE') {
    Carp::croak "expected subroutine reference as last argument";
  }
  my $name = shift || $package;

  my $container;
  if ($_Current_Context) {
    $container = $_Current_Context->context_lookup;

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

  __PACKAGE__->_accumulate_examples({
    container => $container,
    name => $name,
    class => $package,
    code => $code,
    label => $name,
  });
}

# around CODE
sub around(&) {
  my $package = caller;
  my $code = pop;
  if (ref($code) ne 'CODE') {
    Carp::croak "expected subroutine reference as last argument";
  }
  my $context = _autovivify_context($package);
  push @{ $context->around_blocks }, { code => $code };
}

# yield
sub yield() {
  $Yield->();
}

# make context() an alias for describe()
sub context(@);
BEGIN { *context = \&describe }

# used to easily disable suites/specs during development
sub xit(@) {
  local $TODO = '(disabled)';
  it(@_);
}

sub xthey(@) {
  local $TODO = '(disabled)';
  they(@_);
}

sub xdescribe(@) {
  local $TODO = '(disabled)';
  describe(@_);
}

# make xcontext() an alias for xdescribe()
sub xcontext(@);
BEGIN { *xcontext = \&xdescribe }

# shared_examples_for DESC => CODE
sub shared_examples_for($&) {
  my $package = caller;
  my ($name,$code) = @_;
  if (not defined($name)) {
    Carp::croak "expected example group name as first argument";
  }
  if (ref($code) ne 'CODE') {
    Carp::croak "expected subroutine reference as last argument";
  }

  __PACKAGE__->_accumulate_examples({

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

      $context->class( $class );
    }
  }

  # evaluate the context function, which will set up lexical variables and
  # define tests and other contexts
  $context->contextualize($code);
}

# it_should_behave_like DESC
sub it_should_behave_like($) {
  my ($name) = @_;
  if (not defined($name)) {
    Carp::croak "expected example_group_name as first argument";
  }
  if (!$_Current_Context) {
    Carp::croak "it_should_behave_like can only be used inside a describe or shared_examples_for context";
  }
  my $context = $_Shared_Example_Groups{$name} ||
    Carp::croak "unrecognized example group \"$name\"";

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

    open(my $IN, "<", $file)
      || die "could not open spec_helper '$origpath': $!";
    defined(my $content = do { local $/; <$IN> })
      || die "could not read spec_helper '$origpath': $!";
    eval("# line 1 \"$origpath\"\n" . $content);
    die "$@\n" if $@;
  }];
  $sub->($load_path,$filespec);
}

sub share(\%) {
  my $hashref = shift;
  tie %$hashref, 'Test::Spec::SharedHash';
}

sub _materialize_tests {
  my $class = shift;
  my $contexts = $_Package_Contexts{$class};
  if (not $contexts && %$contexts) {
    Carp::carp "no examples defined in spec package $class";
    return;

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


####################
#  Standard tests  #
####################

# This helper and similar strategies below delay loading Test::More
# until we actually use this stuff, so that It Just Works if we:
#     0) have already loaded and planned with Test::More ;-)
#     1) have already loaded and planned with some other Test::Builder module
#     2) aren't actually testing, just trapping
sub _test_more($) {
  my $sym = shift;
  sub {
    require Test::More;
    goto &{"Test::More::$sym"};
  };
}

for my $simple (qw/ is isnt like unlike isa_ok /) {
  $B->test( $simple => 'element, predicate, name', _test_more $simple );
}

( run in 0.784 second using v1.01-cache-2.11-cpan-65fba6d93b7 )