view release on metacpan or  search on metacpan

t/02_flash.t  view on Meta::CPAN

    };

    __PACKAGE__->to_app;
};

sub deftest($&) {
    my ($desc, $sub) = @_;
    subtest $desc => sub {
        test_psgi(
            app => $app,
            client => sub {

 view release on metacpan or  search on metacpan

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

    return $tb->unlike(@_);
}

#line 476

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

    return $tb->cmp_ok(@_);
}

 view release on metacpan or  search on metacpan

lib/Analizo/Batch/Job.pm  view on Meta::CPAN

#   {
#     'field1' => 'value1',
#     'field2' => 10,
#   }
#
sub metadata_hashref($) {
  my ($self) = @_;
  my %hash = map { $_->[0] => $_->[1] } @{$self->metadata()};
  return \%hash;
}

lib/Analizo/Batch/Job.pm  view on Meta::CPAN

  $self->metrics($metrics);

  $self->cleanup();
}

sub project_name($) {
  my ($self) = @_;
  return basename($self->directory);
}

sub cache($) {
  my ($self) = @_;
  $self->{cache} ||= CHI->new(driver => 'File', root_dir => _get_cache_dir());
}

sub _get_cache_dir {

lib/Analizo/Batch/Job.pm  view on Meta::CPAN

  }

  return File::Spec->catfile(File::HomeDir->my_home, '.cache', 'analizo', $Analizo::VERSION)
}

sub tree_id($) {
  my ($self) = @_;
  my @input = sort($self->apply_filters('.'));
  my $sha1 = Digest::SHA->new;
  foreach my $input_file (@input) {
    $sha1->addfile($input_file);

 view release on metacpan or  search on metacpan

lib/Android/Build.pm  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Private methods
#-------------------------------------------------------------------------------

sub getSDKLevels($)                                                             # File name of Android jar for linting
 {my ($android) = @_;                                                           # Android build
  my $l = $android->sdkLevels;
  return @$l if $l and @$l;
  (15,25)
 }

lib/Android/Build.pm  view on Meta::CPAN

$f
END
  $f
 }

sub getDevice($)                                                                # Device to be used
 {my ($android) = @_;
  my $d = $android->device;
  return '-e' unless $d;
  return $d if $d =~ m(\A-)s;
  "-s $d"
 }

sub getAndroidJar($)                                                            # File name of Android jar for linting
 {my ($android) = @_;
  my $p = $android->getPlatform;
  my $a = filePath($p, qw(android.jar));
  -e $a or confess "Cannot find android.jar via file:\n$a\n";
  $a

lib/Android/Build.pm  view on Meta::CPAN

sub getVersion                                                                  # Version of the app or default to today's date
 {my ($a) = @_;
  $a->version // $version;
 }

sub buildArea($)                                                                # Build folder name
 {my ($a) = @_;
  $a->buildFolder // '/tmp/app/'                                                # Either the user supplied build folder name or the default
 }

sub getAssFolder($)     {my ($a) = @_; $a->buildArea.'assets/'}                 # Assets folder name
sub getBinFolder($)     {my ($a) = @_; $a->buildArea.'bin/'}                    # Bin folder name
sub getGenFolder($)     {my ($a) = @_; $a->buildArea.'gen/'}                    # Gen folder name
sub getResFolder($)     {my ($a) = @_; $a->buildArea.'res/'}                    # Res folder name
sub getManifestFile($)  {my ($a) = @_; $a->buildArea.'AndroidManifest.xml'}     # Name of manifest file

sub logMessage($@)                                                              # Log a message
 {my ($android, @message) = @_;
  my $s = join '', grep {$_} @message;
  chomp($s) if $s =~ /\n\Z/;
  push @{$android->log}, $s;
  say STDERR $s if -t STDERR;

lib/Android/Build.pm  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Create resources for app
#-------------------------------------------------------------------------------

sub resources()
 {my ($android)  = @_;
  my $title      = $android->getTitle;
  my $version    = $android->getVersion;
  my $parameters = $android->parameters // '';
  my $package    = $android->getPackage;

lib/Android/Build.pm  view on Meta::CPAN

  filePath($android->getPlatformTools, qw(adb))
 }

my $confirmRequiredUtilitiesAreInPosition;

sub confirmRequiredUtilitiesAreInPosition($)                                    # Confirm required utilities are in position
 {my ($android)  = @_;
  return if $confirmRequiredUtilitiesAreInPosition++;                           # Only do this once per run

  my $buildTools   = $android->getBuildTools;
  my $adb          = $android->getAdb;

lib/Android/Build.pm  view on Meta::CPAN

  zzz("javac -version", qr(javac), 0, "javac not found");
  zzz("zip -v", qr(Info-ZIP), 0, "zip not found\n");
  zzz("$zipAlign", 0, 2, "zipalign not found at:\n$zipAlign");
 }

sub signApkFile($$)                                                             # Sign an apk file
 {my ($android, $apkFile) = @_;                                                 # Android, apk file to sign
  $android->confirmRequiredUtilitiesAreInPosition;

  my $keyStoreFile = $android->keyStoreFileX;
  -e $keyStoreFile or confess"Key store file does not exists:\n$keyStoreFile\n";

lib/Android/Build.pm  view on Meta::CPAN

  zzz("$zipAlign -f 4 $apj $apk");                                              # Zip align

  unlink $_ for $api, $apj;                                                     # Remove intermediate apks
 }

sub cloneApk2($$)                                                               # Clone an apk file: copy the apk, replace the L<assets|assets/>, re-sign, zipalign, return the name of the newly created apk file.
 {my ($android, $oldApk) = @_;                                                  # Android, file name of apk to be cloned
  $android->confirmRequiredUtilitiesAreInPosition;

  confess "Old apk file name not supplied\n"   unless    $oldApk;
  confess "Old apk does not exist:\n$oldApk\n" unless -e $oldApk;

lib/Android/Build.pm  view on Meta::CPAN

  clearFolder($tempFolder, 100);

  return $newApk;
 }

sub compile2($)                                                                 #P Compile the app
 {my ($android) = @_;                                                           # Android build
  $android->create;
  $android->make;                                                               # Compile the app
 }

sub install2($)                                                                 #P Install an already L<compiled|/compile> app on the selected L<device|/device>:
 {my ($android)  = @_;                                                          # Android build
  my $apk        = $android->apk;
  my $device     = $android->getDevice;
  my $package    = $android->getPackage;
  my $activity   = $android->activityX;

lib/Android/Build.pm  view on Meta::CPAN

# say STDERR "Start app";
  zzz("$adb shell am start $package/.Activity");
# say STDERR "App installed and started";
 }

sub lint2($)                                                                    #P Lint all the source code java files for the app
 {my ($android)  = @_;                                                          # Android build
  my $src        = $android->getLintFile;
  my $androidJar = $android->getAndroidJar;
  my $area       = $android->classes // 'Classes';
  makePath($area);
  zzz("javac *.java -d $area -cp $androidJar:$area");                           # Android, plus locally created classes
 }

#1 Methods and attributes

sub new()                                                                       #S Create a new build.
 {bless{action     =>qq(run),
        activity   =>qw(Activity),
        device     =>qq(emulator-5554),
        home       =>$home,
        icon       =>'icon.png',

lib/Android/Build.pm  view on Meta::CPAN

  genLValueScalarMethods(qw(titles));                                           # A hash of translated titles: {ISO::639 2 digit language code=>title in that language}* for this app.
  genLValueScalarMethods(qw(verifyApk));                                        # Verify the signed apk if this is true.
  genLValueScalarMethods(qw(version));                                          # The version number of the app. Default is today's date, formatted as B<YYYYMMDD>
 }

sub compile($)                                                                  # Compile the app.
 {my ($android)  = @_;                                                          # Android build
  eval {&compile2(@_)};
  if ($@)
   {$android->logMessage($@);
    return $@;
   }
  undef                                                                         # No errors encountered
 }

sub cloneApk($$)                                                                # Clone an apk file: copy the existing apk, replace the L<assets|/assets>, re-sign, zipalign, return the name of the newly created apk file.
 {my ($android, $oldApk) = @_;                                                  # Android build, the file name of the apk to be cloned
  &cloneApk2(@_);
 }

sub lint($)                                                                     # Lint all the Java source code files for the app.
 {my ($android)  = @_;                                                          # Android build
  eval {&lint2(@_)};
  if ($@)
   {$android->logMessage($@);
    return $@;
   }
  undef                                                                         # No errors encountered
 }

sub install($)                                                                  # Install an already L<compiled|/compile> app on to the selected L<device|/device>
 {my ($android)  = @_;                                                          # Android build
  eval {&install2(@_)};
  if ($@)
   {$android->logMessage($@);
    return $@;
   }
  undef                                                                         # No errors encountered
 }

sub run($)                                                                      # L<Compile|/compile> the app, L<install|/install> and then run it on the selected L<device|/device>
 {my ($android)  = @_;                                                          # Android build
  for(qw(compile install))                                                      # Compile, install and run
   {my $r = $android->$_;
    return $r if $r;
   }

 view release on metacpan or  search on metacpan

lib/Any/Daemon/FCGI.pm  view on Meta::CPAN

use Log::Report      'any-daemon-http';

use Any::Daemon::FCGI::ClientConn ();


sub new(%)
{   my ($class, %args) = @_;
    $args{Listen} ||= 5;
    $args{Proto}  ||= 'tcp';
    $class->SUPER::new(%args);
}

#----------------

#----------------

sub accept(;$)
{   my $self = shift;
    my $pkg  = shift // 'Any::Daemon::FCGI::ClientConn';
    $self->SUPER::accept($pkg);
}

 view release on metacpan or  search on metacpan

examples/net.pl  view on Meta::CPAN

  , %run_opts
  );

exit 1;   # will never be called

sub run_task()
{
    while(my $client = $socket->accept)
    {   info __x"new client {host}", host => $client->peerhost;
        my $line = <$client>;
        chomp $line;

 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

lib/AnyEvent/AggressiveIdle.pm  view on Meta::CPAN

our @EXPORT         = qw(aggressive_idle);
our @EXPORT_OK      = qw(stop_aggressive_idle aggressive_idle);
our %EXPORT_TAGS    = ( all => [@EXPORT_OK] );

sub stop_aggressive_idle($) {
    our (%IDLE, $WATCHER);

    my ($no) = @_;

    croak "Invalid idle identifier: $no"

lib/AnyEvent/AggressiveIdle.pm  view on Meta::CPAN

            undef $WATCHER unless %IDLE;
        }
    }
}

sub aggressive_idle(&) {
    our ($WOBJ, $WOBJR, %IDLE, $WATCHER, $NO);
    ($WOBJR, $WOBJ) = portable_pipe unless defined $WOBJ;
    $NO = 0 unless defined $NO;

    $WATCHER = AE::io $WOBJ, 1, \&_watcher unless %IDLE;

 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

lib/AnyEvent/Callback.pm  view on Meta::CPAN

    my $new_cb = $cb->CB(sub { ... }, sub { ... }); # the same

=cut

sub CB(&;&) {

    my $parent;
    my ($cb, $ecb) = @_;

    ($parent, $cb, $ecb) = @_ unless 'CODE' eq ref $cb;

 view release on metacpan or  search on metacpan

lib/AnyEvent/CallbackStack.pm  view on Meta::CPAN

package AE::CS;

our $VERSION = $AnyEvent::CallbackStack::VERSION;

sub _reset() {
	eval q{ # poor man's autoloading {}
		*AE::CS = sub {
			AnyEvent::CallbackStack->new
		};
	};

 view release on metacpan or  search on metacpan

lib/AnyEvent/Capture.pm  view on Meta::CPAN

    exports => [qw( capture )],
    groups => { default => [qw( capture )] },
};


sub capture(&) {
    my( $todo ) = @_;
    my $cv = AE::cv;
    my(@results) = $todo->( sub { $cv->send(@_) } );
    return $cv->recv;
}

 view release on metacpan or  search on metacpan

examples/server.pl  view on Meta::CPAN

            }
        );
    };
}

sub main()
{
    my $ld_log = Log::Dispatch->new(
       outputs => [
	    [ 'Syslog', min_level => 'info', ident  => 'chrome-siteshow' ],
	    [ 'Screen', min_level => 'debug', newline => 1 ],

 view release on metacpan or  search on metacpan

lib/AnyEvent/Collect.pm  view on Meta::CPAN

my @cvs;



sub collect_all(&) {
    my( $todo ) = @_;
    my $cv = AE::cv;
    Event::Wrappable->wrap_events( $todo, sub {
        my( $listener ) = @_;
        $cv->begin;

lib/AnyEvent/Collect.pm  view on Meta::CPAN

    } );
    $cv->recv;
}
*collect = *collect_all;

sub collect_any(&) {
    my( $todo ) = @_;
    my $cv = AE::cv;
    Event::Wrappable->wrap_events( $todo, sub {
        my( $listener ) = @_;
        return sub { $listener->(@_); $cv->send };

 view release on metacpan or  search on metacpan

eg/async  view on Meta::CPAN

use Data::Dump 'pp';
my $couch = couch();
my $bad   = couch('http://bad/');
my $done  = AnyEvent->condvar;

sub p(&) {
  $done->begin;
  my $code = shift;
  my $data;
  eval { $data = $code->(); };
  if ($@) {

 view release on metacpan or  search on metacpan

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

    return $tb->unlike(@_);
}

#line 471

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

    return $tb->cmp_ok(@_);
}

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

    return $obj;
}

#line 736

sub subtest($&) {
    my ($name, $subtests) = @_;

    my $tb = Test::More->builder;
    return $tb->subtest(@_);
}

 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

t/test.t  view on Meta::CPAN

use Test::More;
use Test::Requires qw(DBD::SQLite);
use AnyEvent::DBI::Abstract;

sub sync(&;&) {
    my $block = shift;
    my $cb = shift;
    my $cv = AnyEvent->condvar;
    $cv->cb(sub { $cb->($_[0]->recv) }) if $cb;
    $block->($cv);

 view release on metacpan or  search on metacpan

DBI/Slave.pm  view on Meta::CPAN

   my $rc = $DBH->func (@args, $function);
   return [1, $rc, $DBI::err, $DBI::errstr];
}

sub serve($$) {
   my ($fork_fh, $version, $fh) = @_;

   $0 = "dbi slave";

   close $fork_fh;

 view release on metacpan or  search on metacpan

lib/AnyEvent/DNS/Cache/Simple.pm  view on Meta::CPAN

use List::Util qw//;
use Time::HiRes qw//;

our $VERSION = "0.02";

sub request($$) {
   my ($self, $req, $cb) = @_;
   my ($name, $qtype, $class) = @{$req->{qd}[0]};
   my $cache_key = "$class $qtype $name"; #compatibility with Net::DNS::Lite
   if ( my $cached = $self->{adcs_cache}->get($cache_key) ) {
        my ($res,$expires_at) = @$cached;

 view release on metacpan or  search on metacpan

lib/AnyEvent/DNS/EtcHosts.pm  view on Meta::CPAN

our %HOSTS;             # $HOSTS{$nodename}[$ipv6] = [@aliases...]
our @HOSTS_CHECKING;    # callbacks to call when hosts have been loaded
our $HOSTS_MTIME;

sub _parse_hosts($) {
    %HOSTS = ();

    for (split /\n/, $_[0]) {
        s/#.*$//;
        s/^[ \t]+//;

lib/AnyEvent/DNS/EtcHosts.pm  view on Meta::CPAN

        }
    }
}

# helper function - unless dns delivered results, check and parse hosts, then call continuation code
sub _load_hosts_unless(&$@) {
    my ($cont, $cv, @dns) = @_;

    if (@dns) {
        $cv->end;
    } else {

 view release on metacpan or  search on metacpan

FCP.pm  view on Meta::CPAN

use AnyEvent::Handle;
use AnyEvent::Util ();

our %TOLC; # tolc cache

sub touc($) {
   local $_ = shift;
   1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/;
   s/(?:^|_)(.)/\U$1/g;
   $_
}

sub tolc($) {
   local $_ = shift;
   1 while s/(SVK|CHK|URI|FCP|DS|MIME|DDA)([^_])/$1\_$2/;
   1 while s/([^_])(SVK|CHK|URI|FCP|DS|MIME|DDA)/$1\_$2/;
   s/(?<=[a-z])(?=[A-Z])/_/g;
   lc

 view release on metacpan or  search on metacpan

t/04_flush.t  view on Meta::CPAN

print "1..10\n";

use AnyEvent::Fork;
use AnyEvent::Fork::RPC;

sub ok($;$) {
   print $_[0] ? "" : "not ", "ok ", ++$::ok, " # $_[1]\n";
}

ok 1;

 view release on metacpan or  search on metacpan

Remote.pm  view on Meta::CPAN

Quite the same as the same method of L<AnyEvent::Fork>.

=cut

# quote a binary string as a perl scalar
sub sq($) {
   my $s = shift;

   $s =~ /'/
      or return "'$s'";

   $s =~ s/(\x10+)/\x10.'$1'.q\x10/g;
   "q\x10$s\x10"
}

# quote a list of strings
sub aq(@) {
   "(" . (join ",", map sq $_, @_) . ")"
}

sub eval {
   my ($self, $perlcode, @args) = @_;

 view release on metacpan or  search on metacpan

Fork.pm  view on Meta::CPAN

our $EARLY;

# the empty template process
our $TEMPLATE;

sub QUEUE() { 0 }
sub FH()    { 1 }
sub WW()    { 2 }
sub PID()   { 3 }
sub CB()    { 4 }

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

   AnyEvent::Util::fh_nonblocking $fh, 1;

 view release on metacpan or  search on metacpan

t/02_dbi.t  view on Meta::CPAN

    use_ok 'AnyEvent';
    use_ok 'AnyEvent::ForkObject';
    use_ok 'AnyEvent::Tools', 'async_repeat';
}

sub rand_str();

our $tmp_dir = tempdir;
END { remove_tree $tmp_dir if $tmp_dir and -d $tmp_dir };

my $cv = condvar AnyEvent;

t/02_dbi.t  view on Meta::CPAN

});

$cv->recv;


sub rand_str()
{
    my $letters = q!qwertyuiopasdfghjkl;'][zxcvbnm,./йцукенгшщзхъфывапролджэ!;
    my $str = '';
    $str .= substr $letters, int(rand length $letters), 1 for 0 .. 3 + rand 100;
    return $str;

 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

lib/AnyEvent/Future.pm  view on Meta::CPAN

For a full description on how to use Futures, see the L<Future> documentation.

=cut

# Forward
sub as_future(&);

=head1 CONSTRUCTORS

=cut

lib/AnyEvent/Future.pm  view on Meta::CPAN

completion, and which will return a watcher object reference that needs to be
stored somewhere.

=cut

sub as_future(&)
{
   my ( $code ) = @_;

   my $f = AnyEvent::Future->new;

lib/AnyEvent/Future.pm  view on Meta::CPAN

 $w = CODE->( $done_cb, $fail_cb )

=cut

sub as_future_cb(&)
{
   my ( $code ) = @_;

   &as_future( sub {
      my $f = shift;

 view release on metacpan or  search on metacpan

GDB.pm  view on Meta::CPAN

         }
      }
   }
}

sub _q($) {
   return $_[0]
      if $_[0] =~ /^[A-Za-z0-9_]+$/; # we are a lot more strict than the spec

   local $_ = shift;
   utf8::encode $_; # just in case

 view release on metacpan or  search on metacpan

lib/AnyEvent.pm  view on Meta::CPAN

             $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
}

our @post_detect;

sub post_detect(&) {
   my ($cb) = @_;

   push @post_detect, $cb;

   defined wantarray

lib/AnyEvent.pm  view on Meta::CPAN

   &{ shift @POSTPONE }
      while @POSTPONE;
}

sub postpone(&) {
   push @POSTPONE, shift;

   $POSTPONE_W ||= AE::timer (0, 0, \&_postpone_exec);

   ()
}

sub log($$;@) {
   # only load the big bloated module when we actually are about to log something
   if ($_[0] <= ($VERBOSE || 1)) { # also catches non-numeric levels(!) and fatal
      local ($!, $@);
      require AnyEvent::Log; # among other things, sets $VERBOSE to 9
      # AnyEvent::Log overwrites this function

lib/AnyEvent.pm  view on Meta::CPAN

   }

   0 # not logged
}

sub _logger($;$) {
   my ($level, $renabled) = @_;

   $$renabled = $level <= $VERBOSE;

   my $logger = [(caller)[0], $level, $renabled];

lib/AnyEvent.pm  view on Meta::CPAN

          fcntl $_[0], AnyEvent::F_SETFL, $_[1] ? AnyEvent::O_NONBLOCK : 0;
        }
   ;
}

sub fh_block($) {
   _fh_nonblocking shift, 0
}

sub fh_unblock($) {
   _fh_nonblocking shift, 1
}

our @models = (
   [EV::                   => AnyEvent::Impl::EV::],

lib/AnyEvent.pm  view on Meta::CPAN

   grep $_ && $_->[1], @isa_hook
      and AE::_reset ();
}

# used for hooking AnyEvent::Strict and AnyEvent::Debug::Wrap into the class hierarchy
sub _isa_hook($$;$) {
   my ($i, $pkg, $reset_ae) = @_;

   $isa_hook[$i] = $pkg ? [$pkg, $reset_ae] : undef;

   _isa_set;

lib/AnyEvent.pm  view on Meta::CPAN

# all autoloaded methods reserve the complete glob, not just the method slot.
# due to bugs in perls method cache implementation.
our @methods = qw(io timer time now now_update signal child idle condvar);

sub detect() {
   return $MODEL if $MODEL; # some programs keep references to detect

   # IO::Async::Loop::AnyEvent is extremely evil, refuse to work with it
   # the author knows about the problems and what it does to AnyEvent as a whole
   # (and the ability of others to use AnyEvent), but simply wants to abuse AnyEvent

lib/AnyEvent.pm  view on Meta::CPAN

}

# utility function to dup a filehandle. this is used by many backends
# to support binding more than one watcher per filehandle (they usually
# allow only one watcher per fd, so we dup it to get a different one).
sub _dupfh($$;$$) {
   my ($poll, $fh, $r, $w) = @_;

   # cygwin requires the fh mode to be matching, unix doesn't
   my ($rw, $mode) = $poll eq "r" ? ($r, "<&") : ($w, ">&");

lib/AnyEvent.pm  view on Meta::CPAN

package AE;

our $VERSION = $AnyEvent::VERSION;

sub _reset() {
   eval q{
      # fall back to the main API by default - backends and AnyEvent::Base
      # implementations can overwrite these.

      sub io($$$) {

lib/AnyEvent.pm  view on Meta::CPAN

# default implementation for ->signal

our $HAVE_ASYNC_INTERRUPT;

sub _have_async_interrupt() {
   $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT}
                              && eval "use Async::Interrupt 1.02 (); 1")
      unless defined $HAVE_ASYNC_INTERRUPT;

   $HAVE_ASYNC_INTERRUPT

lib/AnyEvent.pm  view on Meta::CPAN

our (%SIG_ASY, %SIG_ASY_W);
our ($SIG_COUNT, $SIG_TW);

# install a dummy wakeup watcher to reduce signal catching latency
# used by Impls
sub _sig_add() {
   unless ($SIG_COUNT++) {
      # try to align timer on a full-second boundary, if possible
      my $NOW = AE::now;

      $SIG_TW = AE::timer

lib/AnyEvent.pm  view on Meta::CPAN

   };
   die if $@;
};

sub sig2num ($) { &$_sig_name_init; &sig2num  }
sub sig2name($) { &$_sig_name_init; &sig2name }

sub signal {
   eval q{ # poor man's autoloading {}
      # probe for availability of Async::Interrupt 
      if (_have_async_interrupt) {

lib/AnyEvent.pm  view on Meta::CPAN

our %PID_CB;
our $CHLD_W;
our $CHLD_DELAY_W;

# used by many Impl's
sub _emit_childstatus($$) {
   my (undef, $rpid, $rstatus) = @_;

   $_->($rpid, $rstatus)
      for values %{ $PID_CB{$rpid} || {} },
          values %{ $PID_CB{0}     || {} };