view release on metacpan or  search on metacpan

t/lib/My/TestHelper.pm  view on Meta::CPAN

our @EXPORT_OK = qw(cmp_file_ok read_file);

my $Test = Test::Builder->new;

# compare string to a file's contents
sub cmp_file_ok($$;$) {
    my ($got, $file, $desc) = @_;

    unless (-e $file and -r $file) {
        $Test->ok(0, $desc);
        $Test->diag("$file not found or not readable");

t/lib/My/TestHelper.pm  view on Meta::CPAN

    }

    return $ok;
}

sub read_file($) {
    my $file = shift;

    local $/ = undef;

    my $fh = FileHandle->new("<$file") or return;

 view release on metacpan or  search on metacpan

t/lib/My/TestHelper.pm  view on Meta::CPAN

our @EXPORT_OK = qw(cmp_file_ok read_file);

my $Test = Test::Builder->new;

# compare string to a file's contents
sub cmp_file_ok($$;$) {
    my ($got, $file, $desc) = @_;

    unless (-e $file and -r $file) {
        $Test->ok(0, $desc);
        $Test->diag("$file not found or not readable");

t/lib/My/TestHelper.pm  view on Meta::CPAN

    }

    return $ok;
}

sub read_file($) {
    my $file = shift;

    local $/ = undef;

    my $fh = FileHandle->new("<$file") or return;

 view release on metacpan or  search on metacpan

lib/Apache2/Response/FileMerge.pm  view on Meta::CPAN

    }
}

sub _minimize_js  { return pop; }
sub _minimize_css { return pop; }
sub _compress($)  { return pop; }
sub _time()       { return 0;   }

1;

__END__

 view release on metacpan or  search on metacpan

lib/Apache2/SiteControl/GrantAllRule.pm  view on Meta::CPAN

   my $this  = { };
   bless ($this, $class);
   return $this;
}

sub grants($$$$)
{
   my $this = shift;
   my $user = shift;
   my $action = shift;
   my $resource = shift;

   return "Default is to allow";
}

sub denies($$$$)
{
   my $this = shift;
   my $user = shift;
   my $action = shift;
   my $resource = shift;

 view release on metacpan or  search on metacpan

t/compress.t  view on Meta::CPAN

use warnings;

use Test::More tests => 29;
use ApacheLog::Compressor;

sub is_hex($$;$) {
	my ($check, $expected, $txt) = @_;
	$txt = '' unless defined $txt;
	my @hex = split / /, $expected;
	is(unpack('H*', $check), join('', @hex), $txt);
}

 view release on metacpan or  search on metacpan

t/01fuses.t  view on Meta::CPAN

use Test::More;

use App::AVR::Fuses;

sub capture(&)
{
   my $code = shift;

   open my $fh, ">", \my $output;
   my $was_outfh = select;

 view release on metacpan or  search on metacpan

lib/App/Asciio/Undo.pm  view on Meta::CPAN

	}

return @diff_lines ;
}

sub CompareStrings($$)
{

=head2 CompareStrings

Returns the following list:

 view release on metacpan or  search on metacpan

scripts/alluniq  view on Meta::CPAN

	      CYAN "  ($Script)\n"  ;
	    return 1 ; 
	}
}

sub tableOutput( ) { 
    ## 2. 度数nの異なる文字列が、具体的にどんな値であったか。
    while ( my( $str, $cnt) = each %str2cnt ) {
       push @{ $cnt2strs {$cnt} }, $str ; 
    }
    my $msep = $o{2} ? "\n" : "\t"  ;

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

inc/Test/Base.pm  view on Meta::CPAN

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

inc/Test/Base.pm  view on Meta::CPAN

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

inc/Test/Base.pm  view on Meta::CPAN

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    

inc/Test/Base.pm  view on Meta::CPAN

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

inc/Test/Base.pm  view on Meta::CPAN

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

inc/Test/Base.pm  view on Meta::CPAN

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

inc/Test/Base.pm  view on Meta::CPAN

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

inc/Test/Base.pm  view on Meta::CPAN

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

inc/Test/Base.pm  view on Meta::CPAN

sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

inc/Test/Base.pm  view on Meta::CPAN

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

inc/Test/Base.pm  view on Meta::CPAN

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

inc/Test/Base.pm  view on Meta::CPAN

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    

inc/Test/Base.pm  view on Meta::CPAN

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

inc/Test/Base.pm  view on Meta::CPAN

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

inc/Test/Base.pm  view on Meta::CPAN

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

inc/Test/Base.pm  view on Meta::CPAN

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

inc/Test/Base.pm  view on Meta::CPAN

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

inc/Test/Base.pm  view on Meta::CPAN

sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view release on metacpan or  search on metacpan

inc/Test/More.pm  view on Meta::CPAN

}


#line 425

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    $tb->cmp_ok(@_);
}

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

inc/Test/Base.pm  view on Meta::CPAN

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

inc/Test/Base.pm  view on Meta::CPAN

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

inc/Test/Base.pm  view on Meta::CPAN

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    

inc/Test/Base.pm  view on Meta::CPAN

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

inc/Test/Base.pm  view on Meta::CPAN

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

inc/Test/Base.pm  view on Meta::CPAN

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

inc/Test/Base.pm  view on Meta::CPAN

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

inc/Test/Base.pm  view on Meta::CPAN

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

inc/Test/Base.pm  view on Meta::CPAN

sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

inc/Test/Base.pm  view on Meta::CPAN

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

inc/Test/Base.pm  view on Meta::CPAN

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

inc/Test/Base.pm  view on Meta::CPAN

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    

inc/Test/Base.pm  view on Meta::CPAN

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

inc/Test/Base.pm  view on Meta::CPAN

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

inc/Test/Base.pm  view on Meta::CPAN

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

inc/Test/Base.pm  view on Meta::CPAN

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

inc/Test/Base.pm  view on Meta::CPAN

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

inc/Test/Base.pm  view on Meta::CPAN

sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

inc/Test/Base.pm  view on Meta::CPAN

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

inc/Test/Base.pm  view on Meta::CPAN

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

inc/Test/Base.pm  view on Meta::CPAN

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    

inc/Test/Base.pm  view on Meta::CPAN

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

inc/Test/Base.pm  view on Meta::CPAN

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

inc/Test/Base.pm  view on Meta::CPAN

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

inc/Test/Base.pm  view on Meta::CPAN

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

inc/Test/Base.pm  view on Meta::CPAN

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

inc/Test/Base.pm  view on Meta::CPAN

sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

inc/Test/Base.pm  view on Meta::CPAN

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

inc/Test/Base.pm  view on Meta::CPAN

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

inc/Test/Base.pm  view on Meta::CPAN

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    

inc/Test/Base.pm  view on Meta::CPAN

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

inc/Test/Base.pm  view on Meta::CPAN

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

inc/Test/Base.pm  view on Meta::CPAN

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

inc/Test/Base.pm  view on Meta::CPAN

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

inc/Test/Base.pm  view on Meta::CPAN

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

inc/Test/Base.pm  view on Meta::CPAN

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

inc/Test/Base.pm  view on Meta::CPAN

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

inc/Test/Base.pm  view on Meta::CPAN

sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view release on metacpan or  search on metacpan

inc/Test/More.pm  view on Meta::CPAN

}


#line 425

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    $tb->cmp_ok(@_);
}

 view release on metacpan or  search on metacpan

lib/App/CamelPKI/CA.pm  view on Meta::CPAN

Builds a list of certificates already issued by the CA and not revoked.
Certificates are returned as an array of L<App::CamelPKI::Certificate>.

=cut

sub get_certificates_issued(){
	my ($self) = @_;
	my @certs;

    for(my $cursor = $self->{db}->search();        
        $cursor->has_more; $cursor->next) {

lib/App/CamelPKI/CA.pm  view on Meta::CPAN

Builds a list of certificates already issued by the CA and not revoked.
Certificates are returned as an array of L<App::CamelPKI::Certificate>.

=cut

sub get_certificates_revoked(){
	my ($self) = @_;
	my @certs;

    for(my $cursor = $self->{db}->search(-revoked => 1);        
        $cursor->has_more; $cursor->next) {

lib/App/CamelPKI/CA.pm  view on Meta::CPAN

Builds a list of certificates already issued by the CA and not revoked.
Certificates are returned as an array of L<App::CamelPKI::Certificate>.

=cut

sub get_certificate_by_serial(){
	my ($self, $serial) = @_;
	
    for(my $cursor = $self->{db}->search( -serial=>$serial, -revoked=>undef ); $cursor->has_more; $cursor->next) {
        	warn "on est bon";
        	return $cursor->certificate;

 view release on metacpan or  search on metacpan

lib/App/Changelord.pm  view on Meta::CPAN

use List::AllUtils qw/ pairmap partition_by /;

use App::Changelord::Role::ChangeTypes;

sub run($self) {
    App::Changelord::Command::Print->new(
        parent_command => $self,
    )->run;
}

 view release on metacpan or  search on metacpan

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $ans .= $components[ int( 4 * rand() ) ];
    return $ans;
}

# close a specific host session
sub terminate_host($) {
    my ( $self, $svr ) = @_;
    $self->debug( 2, "Killing session for $svr" );
    if ( !$servers{$svr} ) {
        $self->debug( 2, "Session for $svr not found" );
        return;

lib/App/ClusterSSH.pm  view on Meta::CPAN

    delete( $servers{$svr} );
    return $self;
}

# catch_all exit routine that should always be used
sub exit_prog() {
    my ($self) = @_;
    $self->debug( 3, "Exiting via normal routine" );

    if ( $self->config->{external_command_pipe}
        && -e $self->config->{external_command_pipe} )

lib/App/ClusterSSH.pm  view on Meta::CPAN

    system($run_command);

    $self->exit_prog;
}

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

    # load up the keyboard map to convert keysyms to keyboardmap
    my $min      = $xdisplay->{min_keycode};
    my $count    = $xdisplay->{max_keycode} - $min;

lib/App/ClusterSSH.pm  view on Meta::CPAN

    #print "$_ => $keyboardmap{$_}\n" foreach(sort(keys(%keyboardmap)));
    #print "keysymtocode: $keysymtocode{o}\n";
    #die;
}

sub get_keycode_state($) {
    my ( $self, $keysym ) = @_;
    $keyboardmap{$keysym} =~ m/^(\D+)(\d+)$/;
    my ( $state, $code ) = ( $1, $2 );

    $self->debug( 2, "keyboardmap=:", $keyboardmap{$keysym}, ":" );

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $self->debug( 2, "returning state=:$state: code=:$code:" );

    return ( $state, $code );
}

sub resolve_names(@) {
    my ( $self, @servers ) = @_;
    $self->debug( 2, 'Resolving cluster names: started' );

    foreach (@servers) {
        my $dirty    = $_;

lib/App/ClusterSSH.pm  view on Meta::CPAN

    my %all = ();
    @all{@_} = 1;
    return ( keys %all );
}

sub change_main_window_title() {
    my ($self) = @_;
    my $number = keys(%servers);
    $windows{main_window}->title( $self->config->{title} . " [$number]" );
}

sub show_history() {
    my ($self) = @_;
    if ( $self->config->{show_history} ) {
        $windows{history}->packForget();
        $windows{history}->selectAll();
        $windows{history}->deleteSelected();

lib/App/ClusterSSH.pm  view on Meta::CPAN

        );
        $self->config->{show_history} = 1;
    }
}

sub update_display_text($) {
    my ( $self, $char ) = @_;

    return if ( !$self->config->{show_history} );

    $self->debug( 2, "Dropping :$char: into display" );

lib/App/ClusterSSH.pm  view on Meta::CPAN

    }

    return $text;
}

sub send_text($@) {
    my $self = shift;
    my $svr  = shift;
    my $text = join( "", @_ );

    $self->debug( 2, "servers{$svr}{wid}=$servers{$svr}{wid}" );

lib/App/ClusterSSH.pm  view on Meta::CPAN

        $self->send_text( $svr, $text )
            if ( $servers{$svr}{active} == 1 );
    }
}

sub send_variable_text_to_all_servers($&) {
    my ( $self, $code ) = @_;

    foreach my $svr ( keys(%servers) ) {
        $self->send_text( $svr, $code->($svr) )
            if ( $servers{$svr}{active} == 1 );
    }
}

sub send_resizemove($$$$$) {
    my ( $self, $win, $x_pos, $y_pos, $x_siz, $y_siz ) = @_;

    $self->debug( 3,
        "Moving window $win to x:$x_pos y:$y_pos (size x:$x_siz y:$y_siz)" );

lib/App/ClusterSSH.pm  view on Meta::CPAN

    );

    #$xdisplay->flush(); # dont flush here, but after all tiling worked out
}

sub open_client_windows(@) {
    my $self = shift;
    foreach (@_) {
        next unless ($_);

        my $server_object = App::ClusterSSH::Host->parse_host_string($_);

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $self->config->{internal_total} = int( keys(%servers) );

    return $self;
}

sub get_font_size() {
    my ($self) = @_;
    $self->debug( 2, "Fetching font size" );

    # get atom name<->number relations
    my $quad_width = $xdisplay->atom("QUAD_WIDTH");

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $self->debug( 2, "Done with font size" );
    return $self;
}

sub show_console() {
    my ($self) = shift;
    $self->debug( 2, "Sending console to front" );

    $self->config->{internal_previous_state} = "mid-change";

lib/App/ClusterSSH.pm  view on Meta::CPAN

    return $self;
}

# set the first argument to the second if the first is undefined
# the equivalent of //= but works in older Perls (e.g. 5.8)
sub slash_slash_equal(\$$) {

    if ( !defined( ${ $_[0] } ) ) {
        ${ $_[0] } = $_[1];
    }

lib/App/ClusterSSH.pm  view on Meta::CPAN

    # and as a last item, set focus back onto the console
    return $self->show_console();
}

sub capture_terminal() {
    my ($self) = @_;
    $self->debug( 0, "Stub for capturing a terminal window" );

    return if ( $self->options->debug_level < 6 );

lib/App/ClusterSSH.pm  view on Meta::CPAN

    print join " ",
        $xdisplay->req( 'GetWindowAttributes', $servers{loki}{wid} ),
        $/;
}

sub toggle_active_state() {
    my ($self) = @_;
    $self->debug( 2, "Toggling active state of all hosts" );

    foreach my $svr ( sort( keys(%servers) ) ) {
        $servers{$svr}{active} = not $servers{$svr}{active};
    }
}

sub set_all_active() {
    my ($self) = @_;
    $self->debug( 2, "Setting all hosts to be active" );

    foreach my $svr ( keys(%servers) ) {
        $servers{$svr}{active} = 1;
    }

}

sub set_half_inactive() {
    my ($self) = @_;
    $self->debug( 2, "Setting approx half of all hosts to inactive" );

    my (@keys) = keys(%servers);
    $#keys /= 2;
    foreach my $svr (@keys) {
        $servers{$svr}{active} = 0;
    }
}

sub close_inactive_sessions() {
    my ($self) = @_;
    $self->debug( 2, "Closing all inactive sessions" );

    foreach my $svr ( sort( keys(%servers) ) ) {
        $self->terminate_host($svr) if ( !$servers{$svr}{active} );
    }
    $self->build_hosts_menu();
}

sub add_host_by_name() {
    my ($self) = @_;
    $self->debug( 2, "Adding host to menu here" );

    $windows{host_entry}->focus();
    my $answer = $windows{addhost}->Show();

lib/App/ClusterSSH.pm  view on Meta::CPAN

    }
}

# attempt to re-add any hosts that have been closed since we started
# the session - either through errors or deliberate log-outs
sub re_add_closed_sessions() {
    my ($self) = @_;
    $self->debug( 2, "add closed sessions" );

    return if ( scalar(@dead_hosts) == 0 );

lib/App/ClusterSSH.pm  view on Meta::CPAN

    else {
        return $self->show_console();
    }
}

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

    return if ( $self->config->{hide_menu} );

    $self->debug( 2, "Building hosts menu" );

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $self->debug( 3, "Changing window title" );
    $self->change_main_window_title();
    $self->debug( 2, "Done" );
}

sub setup_repeat() {
    my ($self) = @_;
    $self->config->{internal_count} = 0;

    # if this is too fast then we end up with queued invocations
    # with no time to run anything else

lib/App/ClusterSSH.pm  view on Meta::CPAN

    return $self;
}

### Window and menu definitions ###

sub create_windows() {
    my ($self) = @_;
    $self->debug( 2, "create_windows: started" );
    $windows{main_window}
        = MainWindow->new( -title => "ClusterSSH", -class => 'cssh', );
    $windows{main_window}->withdraw;    # leave withdrawn until needed

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $self->debug( 2, "create_windows: completed" );

    return $self;
}

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

    # pick up on console minimise/maximise events so we can do all windows
    $windows{main_window}->bind(
        '<Map>' => sub {

lib/App/ClusterSSH.pm  view on Meta::CPAN

    $xdisplay->flush();

    return $self;
}

sub create_menubar() {
    my ($self) = @_;
    $self->debug( 2, "create_menubar: started" );
    $menus{bar} = $windows{main_window}->Menu();

    $windows{main_window}->configure( -menu => $menus{bar}, )

 view release on metacpan or  search on metacpan

lib/App/Cme/Command/run.pm  view on Meta::CPAN

    }

    return;
}

sub run_foreach_loop($self, $opt,$app_args, $script_data ) {
    my %user_args = map { split '=',$_,2; } @{ $opt->{arg} };

    my @dirs = map { chomp ; split /\s+/; }
        ($opt->{foreach} eq '-' ? <STDIN> : ($opt->{foreach}));

 view release on metacpan or  search on metacpan

t/app-codeowners.t  view on Meta::CPAN

# Set progname so that pod2usage knows how to find the script after we chdir.
$0 = path($Bin)->parent->child('bin/git-codeowners')->absolute->stringify;

$ENV{NO_COLOR} = 1;

sub run(&) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
    my $code = shift;
    capture { exit_code { $code->() } };
}

subtest 'basic options' => sub {

 view release on metacpan or  search on metacpan

lib/App/Colorist/Colorizer.pm  view on Meta::CPAN

    my ($self, $c) = @_;
    $self->get_fg($self->eval_color($c));
}


sub bg($) { 
    my ($self, $c) = @_;
    $self->get_bg($self->eval_color($c));
}

 view release on metacpan or  search on metacpan

Control.pm  view on Meta::CPAN

    $self->{SLEEP} = 1 unless defined $self->{SLEEP};
    $self->{ARGS} ||= [];
    return $self;
}

sub running()
{
    my $self = shift;
    my $pid = $self->pid;
    return defined( $pid ) ? kill( 0, $self->{PID} ) : 0;
}

sub pid()
{
    my $self = shift;
    return unless -e $self->{PIDFILE};
    die "Can't read $self->{PIDFILE}\n" unless -r $self->{PIDFILE};
    open( PID, $self->{PIDFILE} ) 

Control.pm  view on Meta::CPAN

        unless $pid =~ /^(\d+)$/
    ;
    return $self->{PID} = $1;
}

sub cmd()
{
    my $self = shift;
    my $cmd = shift;

    return if

 view release on metacpan or  search on metacpan

scripts/multi-homed-routing.pl  view on Meta::CPAN

                                    254 => 'main',
                                    253 => 'default'
                                };


sub DisplayInterfaceInfo($)
{
    my ($interfaces) = @_;

    for my $if (@$interfaces) {
        my $info = $if->info();

scripts/multi-homed-routing.pl  view on Meta::CPAN

        print "\n";
    }
}


sub SuggestSettings($)
{
    my ($interfaces) = @_;
    my @cmd = ();

    my $rt_table_idx = $rt_table_start_number;

scripts/multi-homed-routing.pl  view on Meta::CPAN

    print "\n" if (!$first_suggestion);
    printf("Run commad:\n%s %s\n", $0, join(' ', @cmd));
}


sub _read_routing_tables()
{
    # For table syntax, see: http://linux-ip.net/html/routing-tables.html
    my $tables = {};
    my $rt_table_re = qr/^\s*(\d+)\s+(\S+)/;
    open(RT_TABLE, $rt_table_path) or

scripts/multi-homed-routing.pl  view on Meta::CPAN

#           table =>    Routing-table to use from /etc/iproute2/rt_tables
#           address =>  IPv4 address of the interface
#           network =>  Network of the interface in the form, IPv4-address/netmask
#           gateway =>  IPv4 address of the gateway
#           weight =>   Weight of the route
sub routing_rules($$$)
{
    my ($interfaces, $default_policy, $single_policy_default_interface) = @_;

    my $config = {
        INTERPOLATE => 1,               # expand "$var" in plain text

scripts/multi-homed-routing.pl  view on Meta::CPAN

    return $rules;
}


sub _calculate_network($$)
{
    my ($ipv4_address, $netmask) = @_;

    my $net = new Net::IP($ipv4_address) or
        die "Failed to construct Net::IP. Error: " . Net::IP::Error();

scripts/multi-homed-routing.pl  view on Meta::CPAN

    
    return $network;
}


sub main()
{
    my %opts;
    $opts{'accept-private-dhcp-addresses'} = 0;
    @orig_args = @ARGV;
    GetOptions(\%opts,

 view release on metacpan or  search on metacpan

bin/dtwmic  view on Meta::CPAN

            name => $name
        }
    };
}

sub _enable_touchpads($$) {
    my $toushpads = shift;
    my $is_enable = shift;

    for my $toushpad (values(%$toushpads)) {
        my $cmd = $is_enable ? $config->{'touchpadon'} : $config->{'touchpadoff'};

bin/dtwmic  view on Meta::CPAN

        system(@$cmd);
    }
}

sub _update_state() {
    my $touchpads = {};
    my $has_mouse_devices = 0;

    my $enumerate = $udev->new_enumerate() or
        die("Can't create enumerate context: $@");

 view release on metacpan or  search on metacpan

bin/dapper  view on Meta::CPAN

    # Monitor for changes
    while ( 1 ) { for my $change ($monitor->scan) { if ($change->is_change) { build(); last; } } sleep 1; }
}

sub help() {
    pod2usage({-sections => [ qw(USAGE) ] });
    exit(0);
}

sub version() {
    print "Dapper version $App::Dapper::VERSION\n";
    exit(0);
}

Getopt::Mixed::init(q{h

 view release on metacpan or  search on metacpan

lib/App/DistSync.pm  view on Meta::CPAN

    unlink $file_bak;

    return 1;
}
sub fetch($$$) { # Returns structire
    my $url = shift;
    my $obj = shift;
    my $file = shift;

    my $ret = {

 view release on metacpan or  search on metacpan

lib/App/Dothe.pm  view on Meta::CPAN

    init_arg => undef,
);

use Ref::Util qw/ is_arrayref is_hashref /;

sub render($self,$template,$vars) {
    if( is_arrayref $template ) {
        return [ map { $self->render($_,$vars) } @$template ];
    }

    if( is_hashref $template ) {

lib/App/Dothe.pm  view on Meta::CPAN

    }

    return $self->template($template)->fill_in(HASH => $vars );
}

sub _build_vars($self) {
    my %vars;

    %vars = (
        %vars,
        pairmap { $a => $self->render( $b, \%vars ) } $self->raw_vars->%*

lib/App/Dothe.pm  view on Meta::CPAN

    lazy => 1,
    traits => [ 'Hash' ],
    default => sub($self) { +{} },
);

sub task($self,$name) {
    return $self->{tasks}{$name} ||= App::Dothe::Task->new(
        name => $name, tasks => $self, $self->config->{tasks}{$name}->%* );
}

option file => (

lib/App/Dothe.pm  view on Meta::CPAN

    is => 'ro',
    lazy => 1,
    default => sub($self) { LoadFile( $self->file ) },
);

sub run( $self ) {

    if ( my $code = $self->config->{code} ) {
        eval join '', 'package App::Dothe::Sandbox;', @$code;
    }

 view release on metacpan or  search on metacpan

docs/docs/40-command-options.md  view on Meta::CPAN

[App::Easer][].

The new merging function(s) must support the following signature:

```perl
sub new_merger_default(@list_of_hash_references) { ... }
```

where the input array is the list of hash references to merge, provided
in the same order as the `sources` (but possibly not all of them,
because sources are processed in order).

 view release on metacpan or  search on metacpan

t/lib/Test/NoMore.pm  view on Meta::CPAN

    $tb->unlike(@_);
}



sub cmp_ok($$$;$) {
}



sub can_ok ($@) {