view release on metacpan or  search on metacpan

pride.pm  view on Meta::CPAN

=head1 BUGS

There's no unimport. There's no way to specify an import list to
C<use strict;> or C<use warnings;>. There's no way to exclude specific
modules (eg C<Exporter>) from the clutches C<Acme::use::strict:with::pride>.
The error and warning handling is global, rather than being chained, and it
won't play nicely with error objects. The source filter in coderef C<@INC> is
undocumented, so I shouldn't be using it.

=head1 AUTHOR

Nicholas Clark, E<lt>nick@talking.bollo.cxE<gt>

 view release on metacpan or  search on metacpan

lib/Acrux/DBI.pm  view on Meta::CPAN

See also L</begin>, L</rollback>

=head2 connect

    my $dbi = $dbi->connect;
    die $dbi->error if $dbi->error;

This method makes a connection to the database

=head2 connect_cached

    my $dbi = $dbi->connect_cached;
    die $dbi->error if $dbi->error;

This method makes a cached connection to the database. See L<DBI/connect_cached> for details

=head2 database

lib/Acrux/DBI.pm  view on Meta::CPAN

    my $errstr = $dbi->errstr;

This method just returns C<$DBI::errstr> value

=head2 error

    my $error = $dbi->error;

Returns error string if occurred any errors while working with database

    $dbi = $dbi->error( "error text" );

Sets new error message and returns object

=head2 host

    my $host = $dbi->host;

lib/Acrux/DBI.pm  view on Meta::CPAN

            uri     => $uri,
            dsn     => '',
            cachekey=> '',
            driver  => '',
            dbh     => undef,
            error   => "", # Ok
            autoclean => $autoclean ? 1 : 0,
            opts    => {%_opts},
            cache   => Mojo::Cache->new,
        }, $class;
    return $self;

lib/Acrux/DBI.pm  view on Meta::CPAN

    $self->{cachekey} = md5_sum($self->{url} . $sfx);
}
sub dbh { shift->{dbh} }

# Methods
sub error {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{error} = shift;
        return $self;
    }
    return $self->{error};
}
sub err {
    my $self = shift;
    return $self->dbh->err // $DBI::err if defined($self->dbh) && $self->dbh->can('err');
    return $DBI::err;

lib/Acrux/DBI.pm  view on Meta::CPAN

}

# Database methods
sub connect {
    my $self = shift;
    $self->{error} = '';
    my $dbh = DBI->connect($self->dsn, $self->username, $self->password, $self->options);
    if ($dbh) {
        $self->{dbh} = $dbh;
        printf STDERR "Connected to '%s'\n", $self->dsn if DEBUG;
    } else {
        $self->{error} = $DBI::errstr || "DBI->connect failed";
        $self->{dbh} = undef;
    }
    return $self;
}
sub connect_cached {
    my $self = shift;
    $self->{error} = '';
    my %opts = %{($self->options)};
       $opts{private_cachekey} = $self->cachekey;
    my $dbh = DBI->connect_cached($self->dsn, $self->username, $self->password, {%opts});
    if ($dbh) {
        $self->{dbh} = $dbh;
        printf STDERR "Connected (cached) to '%s'\n", $self->dsn if DEBUG;
    } else {
        $self->{error} = $DBI::errstr || "DBI->connect failed";
        $self->{dbh} = undef;
    }
    return $self;
}
sub disconnect {

lib/Acrux/DBI.pm  view on Meta::CPAN

        ? {bind_values => [@_]}
        : ref($_[0]) eq 'HASH'
          ? {%{$_[0]}}
          : {bind_values => [@_]}
      : {};
    $self->{error} = '';
    return unless my $dbh = $self->dbh;
    unless (length($sql)) {
        $self->error("No statement specified");
        return;
    }

    # Prepare
    my $sth = $dbh->prepare($sql);
    unless ($sth) {
        $self->error(sprintf("Can't prepare statement \"%s\": %s", $sql,
            $dbh->errstr || $DBI::errstr || 'unknown error'));
        return;
    }

    # HandleError
    local $sth->{HandleError} = sub { $_[0] = Carp::shortmess($_[0]); 0 };

    # Binding params and execute
    my $bind_values = $args->{bind_values} || [];
    unless (is_array_ref($bind_values)) {
        $self->error("Invalid list of binding values. Array ref expected");
        return;
    }
    my $rv;
    my $argb = '';
    if (scalar @$bind_values) {

lib/Acrux/DBI.pm  view on Meta::CPAN

            join(", ", map {defined($_) ? sprintf("'%s\'", $_) : 'undef'} @$bind_values));

        $rv  = $sth->execute(@$bind_values);
    } elsif (my $cb = $args->{bind_callback} || $args->{bind_cb}) {
        unless (is_code_ref($cb)) {
            $self->error("Invalid binding callback function. Code ref expected");
            return;
        }
        $cb->($sth); # Callback! bind params
        $rv = $sth->execute;
    } else {
        $rv = $sth->execute; # Without bindings
    }
    unless (defined $rv) {
        $self->error(sprintf("Can't execute statement \"%s\"%s: %s", $sql, $argb,
            $sth->errstr || $dbh->errstr || $DBI::errstr || 'unknown error'));
        return;
    }

    # Result
    return Acrux::DBI::Res->new(

 view release on metacpan or  search on metacpan

eg/acrux_lite.pl  view on Meta::CPAN

#!/usr/bin/perl -w
use strict;

# perl -Ilib eg/acrux_lite.pl ver
# perl -Ilib eg/acrux_lite.pl test 1 2 3
# perl -Ilib eg/acrux_lite.pl error

use Acme::Crux;
use Acrux::Util qw/dumper color/;

my $app = Acme::Crux->new(

eg/acrux_lite.pl  view on Meta::CPAN

        });
    return 1;
});

$app->register_handler(
    handler     => "error",
    description => "Error test handler",
    code => sub {
### CODE:
    my ($self, $meta, @args) = @_;
    $self->error("My test error string");
    return 0;
});

my $command = shift(@ARGV) // 'default';
my @arguments = @ARGV ? @ARGV : ();

eg/acrux_lite.pl  view on Meta::CPAN

    die color("bright_red" => "No handler $command found") . "\n";
}

# Run
my $exitval = $app->run($command, @arguments) ? 0 : 1;
warn color("bright_red" => $app->error) . "\n" and exit $exitval if $exitval;

1;

__END__

 view release on metacpan or  search on metacpan

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

use Moo;



has error_if_code => (
    is => 'ro',
    required => 1,
    isa => sub { ref $_[0] eq 'CODE' },
    default => sub { sub { $_[0] }; },
);

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

        $self->_circuit_open_until(0);
        $self->has_on_circuit_close
          and $self->on_circuit_close->();
    }

    my $error;
    my @attempt_result;
    my $attempt_result;
    my $wantarray;
          
    if (wantarray) {
        $wantarray = 1;
        @attempt_result = eval { $attempt_code->(@_) };
        $error = $@;
    } elsif ( ! defined wantarray ) {
        eval { $attempt_code->(@_) };
        $error = $@;
    } else {
        $attempt_result = eval { $attempt_code->(@_) };
        $error = $@;
    }

    my $h = { action_retry => $self,
              attempt_result => ( $wantarray ? \@attempt_result : $attempt_result ),
              attempt_parameters => \@_,
            };


    if ($self->error_if_code->($error, $h)) {
        $self->_current_retries_number($self->_current_retries_number + 1);
        if ($self->_current_retries_number >= $self->max_retries_number) {
            my ($seconds, $microseconds) = gettimeofday;
            my $open_until = ($self->open_time * 1000) + ($seconds * 1000 + int($microseconds / 1000));
            $self->_circuit_open_until($open_until);
            $self->has_on_circuit_open
              and $self->on_circuit_open->();
        }
        die $error;
    } else {
        return $h->{attempt_result};
    }
}

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

  use Action::CircuitBreaker;
  Action::CircuitBreaker->new()->run(sub { do_stuff; });

=head1 ATTRIBUTES

=head2 error_if_code

  ro, CodeRef

The code to run to check if the error should count towards the circuit breaker. It defaults to:

  # Returns true if there were an exception evaluating to something true
  sub { $_[0] }

It will be given these arguments:

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

It's the reference on the parameters that were given to C<$attempt_code>.

=back

C<error_if_code> return value will be interpreted as a boolean : true return
value means the execution of C<$attempt_code> was a failure and should count
towards breaking the ciruit. False means it went well.

Here is an example of code that gets the arguments properly:

  my $action = Action::CircuitBreaker->new(
    error_if_code => sub {
      my ($error, $h) = @_;

      my $attempt_code_result = $h->{attempt_result};
      my $attempt_code_params = $h->{attempt_parameters};

      my @results = @$attempt_code_result;

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

  ro, CodeRef, optional

If given, will be executed when an execution fails.

It will be given the same arguments as C<error_if_code>. See C<error_if_code> for their descriptions

=head2 on_circuit_open

  ro, CodeRef, optional

If given, will be executed the circuit gets opened.

It will be given the same arguments as C<error_if_code>. See C<error_if_code> for their descriptions

=head2 on_circuit_close

  ro, CodeRef, optional

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

=over

=item step 1

Tests the value of C<_circuit_open_until>. If it is positive and the current
timestamp is before the value, an error is thrown, because the circuit is
still open. If the value is positive, but before the current timestamp,
the circuit is closed (by setting C<_circuit_open_until> to 0) and optionally,
C<on_circuit_close> is run.

=item step 2

If the value of C<_circuit_open_until> is 0, the circuit is closed, and the
passed sub gets executed. Then it runs the C<error_if_code> CodeRef in
scalar context, giving it as arguments C<$error>, and the return values
of C<$attempt_code>. If it returns true, we consider that it was a failure,
and move to step 3. Otherwise, we consider it
means success, and return the return values of C<$attempt_code>.

=item step 3

Increase the value of C<_current_retries_number> and check whether it is
larger than C<max_retries_number>. If it is, then open the circuit by setting
C<_circuit_open_until> to the current time plus C<open_time>, and optionally
run C<on_circuit_open>. Then, die with the C<$error> from C<$attempt_code>.

=item step 4

Runs the C<on_failure_code> CodeRef in the proper context, giving it as
arguments C<$error>, and the return values of C<$attempt_code>, and returns the
results back to the caller.

=back

Arguments passed to C<run()> will be passed to C<$attempt_code>. They will also

 view release on metacpan or  search on metacpan

lib/Action/Retry.pm  view on Meta::CPAN

              or return;
            $self->_needs_sleeping_until(0);
            $self->strategy->next_step;
        }

        my $error;
        my @attempt_result;
        my $attempt_result;
        my $wantarray;
          
        if (wantarray) {
            $wantarray = 1;
            @attempt_result = eval { $self->attempt_code->(@_) };
            $error = $@;
        } elsif ( ! defined wantarray ) {
            eval { $self->attempt_code->(@_) };
            $error = $@;
        } else {
            $attempt_result = eval { $self->attempt_code->(@_) };
            $error = $@;
        }

        my $h = { action_retry => $self,
                  attempt_result => ( $wantarray ? \@attempt_result : $attempt_result ),
                  attempt_parameters => \@_,
                };


        $self->retry_if_code->($error, $h )
          or $self->strategy->reset, $@ = $error, return ( $wantarray ? @attempt_result : $attempt_result );

        if (! $self->strategy->needs_to_retry) {
            $self->strategy->reset;
            $self->has_on_failure_code
              and return $self->on_failure_code->($error, $h);
            return;
        }

        if ($self->non_blocking) {
            my ($seconds, $microseconds) = gettimeofday;

lib/Action/Retry.pm  view on Meta::CPAN

  my $action = Action::Retry->new(
    attempt_code => sub { do_stuff; } )->run();
    attempt_code => sub { map { $_ * 2 } @_ }
    retry_if_code => sub {
      my ($error, $h) = @_;

      my $attempt_code_result = $h->{attempt_result};
      my $attempt_code_params = $h->{attempt_parameters};

      my @results = @$attempt_code_result;

lib/Action/Retry.pm  view on Meta::CPAN

=over

=item step 1

Runs the C<attempt_code> CodeRef in the proper context in an eval {} block,
saving C<$@> in C<$error>.

=item step 2

Runs the C<retry_if_code> CodeRef in scalar context, giving it as arguments
C<$error>, and the return values of C<attempt_code>. If it returns true, we
consider that it was a failure, and move to step 3. Otherwise, we consider it
means success, and return the return values of C<attempt_code>.

=item step 3

lib/Action/Retry.pm  view on Meta::CPAN

and go back to step 2. If not, go to step 4.

=item step 4

Runs the C<on_failure_code> CodeRef in the proper context, giving it as
arguments C<$error>, and the return values of C<attempt_code>, and returns the
results back to the caller.

=back

Arguments passed to C<run()> will be passed to C<attempt_code>. They will also

 view release on metacpan or  search on metacpan

bin/activator.pl  view on Meta::CPAN

				      ABSOLUTE => 1,
				      OUTPUT_PATH  => $config->{sync_conf_dir},
				    }
				  );
	    DEBUG( qq(tt processing: $fq_source_file, $config, $out ));
	    $tt->process( $fq_source_file, $config, $out ) || Activator::Log->logdie( $tt->error()."\n");
	}

	# just copy the file
	else {
	    my $rsync_flags = ( $config->{debug} ? '-v' : '' );

bin/activator.pl  view on Meta::CPAN

    my $tt = Template->new( { DEBUG => 1,
			      ABSOLUTE => 1,
			      OUTPUT_PATH  => $config->{apache2}->{ServerRoot},
			    }
			  );
    $tt->process( $fq, $config, $out ) || Activator::Log->logdie( $tt->error()."\n");

    # TODO: use some smart hueristics to properly chmod that which
    # should be executable
    #
    #if( $out =~ m@/s?bin/|/init.d/@ ) {

 view release on metacpan or  search on metacpan

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

    my ($class, $dsn, $username, $password, $options) = @_;

    eval { require DBIx::Connector };

    $options->{HandleError} = sub {
        my ($error_message, $DBI_st) = @_;

        $error_message or return;
        croak $error_message;

    } if ! exists $options->{HandleError};

    if ($@) {
        $connector = ActiveRecord::Simple::Connect->new($dsn, $username, $password, $options);

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

        my $relation           = $relations->{$relation_name};
        my $full_relation_type = _get_relation_type($class, $relation);
        my $related_class      = _get_related_class($relation);

        ### TODO: check for error if returns undef
        my $pk = $relation->{params}{pk};
        my $fk = $relation->{params}{fk};

        my $instance_name = "relation_instance_$relation_name";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }

Please invoke ${\__PACKAGE__} with:

inc/Module/Install.pm  view on Meta::CPAN

	# If the modification time is only slightly in the future,
	# sleep briefly to remove the problem.
	my $a = $s - time;
	if ( $a > 0 and $a < 5 ) { sleep 5 }

	# Too far in the future, throw an error.
	my $t = time;
	if ( $s > $t ) { die <<"END_DIE" }

Your installer $0 has a modification time in the future ($s > $t).

 view release on metacpan or  search on metacpan

lib/Activiti/Rest/Error.pm  view on Meta::CPAN

has status_code => (
    is => 'ro',
    required => 1
);
#prior to activiti version 5.17, now exception
has error_message => (
    is => 'ro',
    required => 1
);
#from activiti version 5.17, formerly errorMessage
has exception => (
    is => 'ro',
    required => 1
);
has content_type => (

 view release on metacpan or  search on metacpan

lib/Adam/Logger/API.pm  view on Meta::CPAN

  log
  debug
  info
  notice
  warning
  error
  critical
  alert
  emergency
);

 view release on metacpan or  search on metacpan

t/00-report-prereqs.t  view on Meta::CPAN

else {
    $source = 'static metadata';
}

my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;

# Add static includes into a fake section
for my $mod (@include) {
    $req_hash->{other}{modules}{$mod} = 0;

t/00-report-prereqs.t  view on Meta::CPAN

                $have = "undef" unless defined $have;
                push @reports, [$mod, $want, $have];

                if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
                    if ( $have !~ /\A$lax_version_re\z/ ) {
                        push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
                    }
                    elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
                        push @dep_errors, "$mod version '$have' is not in required range '$want'";
                    }
                }
            }
            else {
                push @reports, [$mod, $want, "missing"];

                if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
                    push @dep_errors, "$mod is not installed ($req_string)";
                }
            }
        }

        if ( @reports ) {

t/00-report-prereqs.t  view on Meta::CPAN

if ( @full_reports ) {
    diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}

if ( @dep_errors ) {
    diag join("\n",
        "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
        "The following REQUIRED prerequisites were not satisfied:\n",
        @dep_errors,
        "\n"
    );
}

pass;

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

0.04    2022-05-13
    - s/distmgr/myip/ in module POD description

0.03    2022-05-11
    - Print response content (error message) if API failure occurs
    - Add prereq of Hook::Output::Tiny for testing a non-200 API response

0.02    2022-05-11
    - POD fixes
    - Modifications to Github CI Actions configuration

 view release on metacpan or  search on metacpan

lib/Address/PostCode/UserAgent.pm  view on Meta::CPAN

=head1 METHODS

=head2 get($url, \%headers)

It requires URL and optionally headers. It returns the standard response.On error
throws exception of type L<Address::PostCode::UserAgent::Exception>.

=cut

sub get {

 view release on metacpan or  search on metacpan

lib/AddressBook.pm  view on Meta::CPAN

If no match is found, the entry is added to the master.

=item Z<>

If multiple matches are found, an error occurrs.

=item Z<>

If one match is found, then:

 view release on metacpan or  search on metacpan

lib/Ado/Command.pm  view on Meta::CPAN

A default C<$command-E<gt>run(@args)> method for all Ado::Command commands.
This is the entry point to your mini application.
Looks for subcommands/actions which are looked up in
the C<--do> commands line argument and executed.
Dies with an error message advising you to implement the subcommand
if it is not found in  C<$self-E<gt>config-E<gt>{actions}>.
Override it if you want specific behavior.

    # as bin/ado alabala --do action --param1 value
    Ado::Command::alabala->run(@ARGV);

 view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

inherited from the call to B<new>.

This method ignores any request to source in other config files.  You must
encrypt each file individually.

It is an error if basename(I<$file>) is a symbolic link and you didn't provide
I<$encryptFile>.

Returns:  B<1> if something was encrypted.  B<-1> if nothing was encrypted.
Otherwise B<0> on error.

=cut

sub encrypt_config_file
{

Config.pm  view on Meta::CPAN

      return DBUG_RETURN ( croak_helper ( $rOpts, $msg, 0 ) );
   }

   my $status = encrypt_config_file_details ($file, $scratch, $rOpts);

   # Some type of error ... or nothing was encrypted ...
   if ( $status == 0 || $status == -1 ) {
      unlink ( $scratch );

   # Replacing the original file ...
   } elsif ( ! $newFile ) {

Config.pm  view on Meta::CPAN

inherited from the call to B<new>.

This method ignores any request to source in other config files.  You must
decrypt each file individually.

It is an error if basename(I<$file>) is a symbolic link and you didn't provide
I<$decryptFile>.

Returns:  B<1> if something was decrypted.  B<-1> if nothing was decrypted.
Otherwise B<0> on error.

=cut

sub decrypt_config_file
{

Config.pm  view on Meta::CPAN

      return DBUG_RETURN ( croak_helper ( $rOpts, $msg, undef ) );
   }

   my $status = decrypt_config_file_details ($file, $scratch, $rOpts);

   # Some type of error ... or nothing was decrypted ...
   if ( $status == 0 || $status == -1 ) {
      unlink ( $scratch );

   # Replacing the original file ...
   } elsif ( ! $newFile ) {

 view release on metacpan or  search on metacpan

Infix2Postfix.pm  view on Meta::CPAN

}

sub translate {
    my $self=shift;
    my $str=shift;
    my (@matches,@errors,@res);
    
    @matches=$self->tokenize($str);
    @errors=$self->verify(@matches);

    if (@errors) {
      $self->{ERRSTR}='Bad tokens: '.join(' ',@matches[@errors]);
      return undef;
    }

    @res=$self->elist(@matches);
    return @res;

Infix2Postfix.pm  view on Meta::CPAN

  if ( $_[0] eq '(' and $_[$#_] eq ')' ) {
    if ( $#_<2 ) { die "Empty parens\n"; }
    return $self->elist(@_[1..$#_-1]);
  }
  
  die "error stack is: @_ error\n";
}

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

 view release on metacpan or  search on metacpan

builder/Affix.pm  view on Meta::CPAN

            ( jobs  => $opt{jobs} ) x !!exists $opt{jobs},
            ( color => 1 ) x !!-t STDOUT,
            lib => [ map { rel2abs( catdir( qw/blib/, $_ ) ) } qw/arch lib/ ],
        );
        my $tester = TAP::Harness::Env->create( \%test_args );
        return $tester->runtests( sort +find( qr/\.t$/, 't' ) )->has_errors;
    },
    install => sub {
        my %opt = @_;
        die "Must run `./Build build` first\n" if not -d 'blib';
        install( $opt{install_paths}->install_map, @opt{qw/verbose dry_run uninst/} );

builder/Affix.pm  view on Meta::CPAN

    my ( $file, $dest ) = @_;
    my $retval;
    my $u = IO::Uncompress::Unzip->new($file) or die "Cannot open $file: $UnzipError";
    my %dirs;
    for ( my $status = 1; $status > 0; $status = $u->nextStream() ) {
        last if $status < 0;    # bail on error
        my $header = $u->getHeaderInfo();

        #ddx $header;
        my $destfile = $dest->child( $header->{Name} );
        next if $header->{Name} =~ m[/$];    # Directory

 view release on metacpan or  search on metacpan

lib/Agent/TCLI/Package/Net.pm  view on Meta::CPAN

Eric Hacker	 E<lt>hacker at cpan.orgE<gt>

=head1 BUGS

This is only documentation, but there is probably a speeling error or a
grammer mistake lurking about.

=head1 LICENSE

Copyright (c) 2007, Alcatel Lucent, All rights resevred.

 view release on metacpan or  search on metacpan

lib/Agent/TCLI/Base.pm  view on Meta::CPAN

# Standard class utils
# I need to redo err handling as its not useful as is.
=item err

Error message if something went wrong with a method call. Cannot be set or
passed in with new. Not actually used, as erroring needs to be revisited.

=cut
my @err				:Field
					:Get('err');

 view release on metacpan or  search on metacpan

examples/Eval.pa  view on Meta::CPAN

		unless ($to = delete($self->{Return})) {
			print "I've been abandoned!\n" if $self->{verbose};
			return;
		}
		@message = eval "$self->{Eval}";
		push @message, "ERROR: $@" if $@; # capture errors, if any
	}

	# transfer self | send result to remote host...
	print "Sending message to $to\n" if $self->{verbose};
	my $msg = new Agent::Message(

 view release on metacpan or  search on metacpan

lib/Agents/Bureau.pm  view on Meta::CPAN

=head1 DIAGNOSTICS

=for author to fill in:
    List every single error and warning message that the module can
    generate (even the ones that will "never happen"), with a full
    explanation of each problem, one or more likely causes, and any
    suggested remedies.

=over

=item C<< Error message here, perhaps with %s placeholders >>

[Description of error here]

=item C<< Another error message here >>

[Description of error here]

[Et cetera, et cetera]

=back

 view release on metacpan or  search on metacpan

lib/Agents/Platform.pm  view on Meta::CPAN

=head1 DIAGNOSTICS

=for author to fill in:
    List every single error and warning message that the module can
    generate (even the ones that will "never happen"), with a full
    explanation of each problem, one or more likely causes, and any
    suggested remedies.

=over

=item C<< Error message here, perhaps with %s placeholders >>

[Description of error here]

=item C<< Another error message here >>

[Description of error here]

[Et cetera, et cetera]

=back

 view release on metacpan or  search on metacpan

lib/Aion/Format.pm  view on Meta::CPAN

sub accesslog(@) {
	print "[", POSIX::strftime("%F %T", localtime), "] ", coloring @_;
}

# Для крона: Пишет в STDIN
sub errorlog(@) {
	print STDERR "[", POSIX::strftime("%F %T", localtime), "] ", coloring @_;
}


#@category Преобразования

lib/Aion/Format.pm  view on Meta::CPAN

It write in STDOUT C<coloring> returns with prefix datetime.

	trappout { accesslog "#{green}ACCESS#r %i\n", 6 }  # ~> \[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[32mACCESS\e\[0m 6\n

=head2 errorlog ($format, @params)

It write in STDERR C<coloring> returns with prefix datetime.

	trapperr { errorlog "#{red}ERROR#r %i\n", 6 }  # ~> \[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[31mERROR\e\[0m 6\n

=head2 flesch_index_human ($flesch_index)

Convert flesch index to russian label with step 10.

 view release on metacpan or  search on metacpan

lib/Aion/Fs.pm  view on Meta::CPAN

	($path) = @$path if ref $path;
	
	$path = $fs->{before_split}->($path) if exists $fs->{before_split};
	
	+{
		$path =~ $fs->{regexp}? (map { $_ ne "ext" && $+{$_} eq ""? (): ($_ => $+{$_}) } keys %+): (error => 1),
		path => $path,
	}
}

# Переводит путь из формата одной ОС в другую

lib/Aion/Fs.pm  view on Meta::CPAN

# Найти файлы
sub find(;@) {
	my $file = @_? shift: $_;
    $file = [$file] unless ref $file;

	my @noenters; my $errorenter = sub {};
	my $ex = @_ && ref($_[$#_]) =~ /^Aion::Fs::(noenter|errorenter)\z/ ? pop: undef;

	if($ex) {
		if($1 eq "errorenter") {
			$errorenter = $ex;
		} else {
			$errorenter = pop @$ex if ref $ex->[$#$ex] eq "Aion::Fs::errorenter";
			push @noenters, _filters @$ex;
		}
	}
	
	my @filters = _filters @_;

lib/Aion/Fs.pm  view on Meta::CPAN

				for my $noenter (@noenters) {
					local $_ = $path;
					next FILE if $noenter->();
				}

				opendir my $dir, $path or do { local $_ = $path; $errorenter->(); next FILE };
				my @file;
				while(my $f = readdir $dir) {
					push @file, File::Spec->join($path, $f) if $f !~ /^\.{1,2}\z/;
				}
				push @$file, sort @file;

lib/Aion/Fs.pm  view on Meta::CPAN

sub noenter(@) {
	bless [@_], "Aion::Fs::noenter"
}

# Вызывается для всех ошибок ввода-вывода
sub errorenter(&) {
	bless shift, "Aion::Fs::errorenter"
}

# Останавливает find будучи вызван с одного из его фильтров, errorenter или noenter
sub find_stop() {
	die bless {}, "Aion::Fs::stop"
}

# Производит замену во всех указанных файлах. Возвращает файлы в которых замен не было

lib/Aion/Fs.pm  view on Meta::CPAN

	[map cat, grep -f, find ["hello/big", "hello/small"]]  # --> [qw/ hellow! noenter /]
	
	my @noreplaced = replace { s/h/$a $b H/ }
	    find "hello", "-f", "*.txt", qr/\.txt$/, sub { /\.txt$/ },
	        noenter "*small*",
	            errorenter { warn "find $_: $!" };
	
	\@noreplaced # --> ["hello/moon.txt"]
	
	cat "hello/world.txt"       # => hello/world.txt :utf8 Hi!
	cat "hello/moon.txt"        # => noreplace

lib/Aion/Fs.pm  view on Meta::CPAN

Если фильтр -X не является файловой функцией perl, то выбрасывается исключение:

	eval { find "example", "-h" }; $@   # ~> Undefined subroutine &Aion::Fs::h called

В этом примере C<find> не может войти в подкаталог и передаёт ошибку в функцию C<errorenter> (см. ниже) с установленными переменными C<$_> и C<$!> (путём ...

B<Внимание!> Если C<errorenter> не указана, то все ошибки B<игнорируются>!

	mkpath ["example/", 0];
	
	[find "example"]                  # --> ["example"]
	[find "example", noenter "-d"]    # --> ["example"]
	
	eval { find "example", errorenter { die "find $_: $!" } }; $@   # ~> find example: Permission denied
	
	mkpath for qw!ex/1/11 ex/1/12 ex/2/21 ex/2/22!;
	
	my $count = 0;
	find "ex", sub { find_stop if ++$count == 3; 1}  # -> 2

lib/Aion/Fs.pm  view on Meta::CPAN

=head2 noenter (@filters)

Говорит C<find> не входить в каталоги соответствующие фильтрам за ним.

=head2 errorenter (&block)

Вызывает C<&block> для каждой ошибки возникающей при невозможности войти в какой-либо каталог.

=head2 find_stop ()

Останавливает C<find> будучи вызван в одном из его фильтров, C<errorenter> или C<noenter>.

	my $count = 0;
	find "ex", sub { find_stop if ++$count == 3; 1}  # -> 2

=head2 erase (@paths)

 view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

    $s
}

# конструктор
sub new {
	my ($self, @errors) = create_from_params(@_);

	die join "", "has:\n\n", map "* $_\n", @errors if @errors;

	$self
}

# Устанавливает свойства и выдаёт объект и ошибки

lib/Aion.pm  view on Meta::CPAN

	my $self = bless {}, $cls;

	my @init;
	my @required;
	my @errors;
    my $FEATURE = $Aion::META{$cls}{feature};

	while(my ($name, $feature) = each %$FEATURE) {

		if(exists $value{$name}) {
			my $val = delete $value{$name};

			if(!$feature->{excessive}) {
				$val = $feature->{coerce}->coerce($val) if $feature->{coerce};

				push @errors, $feature->{isa}->detail($val, "Feature $name")
                    if ISA =~ /w/ && $feature->{isa} && !$feature->{isa}->include($val);
				$self->{$name} = $val;
				push @init, $feature if $feature->{init};
			}
			else {
				push @errors, "Feature $name cannot set in new!";
			}
		} elsif($feature->{required}) {
            push @required, $name;
        } elsif(exists $feature->{default}) {
			$self->{$name} = $feature->{default};

lib/Aion.pm  view on Meta::CPAN

		for my $init (@{$feature->{init}}) {
			$init->($self, $feature);
		}
	}

	do {local $" = ", "; unshift @errors, "Features @required is required!"} if @required > 1;
	unshift @errors, "Feature @required is required!" if @required == 1;

	my @fakekeys = sort keys %value;
	unshift @errors, "@fakekeys is not feature!" if @fakekeys == 1;
	do {local $" = ", "; unshift @errors, "@fakekeys is not features!"} if @fakekeys > 1;

	return $self, @errors;
}

1;

__END__

 view release on metacpan or  search on metacpan

lib/Akado/Account.pm  view on Meta::CPAN

sub _check_response {
    my ($self, $response) = @_;

    my $url = scalar $response->request->uri->canonical;
    if ($response->is_error) {
        croak "Can't get url '$url'. Got error "
            . $response->status_line;
    }

    return '';
}

lib/Akado/Account.pm  view on Meta::CPAN

info from that site.

Unfortunately Akdado account site has no API, so this module acts as a browser
to get needed info.

Every module method dies in case of error.

=head1 DESCRIPTION

Akado::Account version numbers uses Semantic Versioning standart.
Please visit L<http://semver.org/> to find out all about this great thing.

lib/Akado/Account.pm  view on Meta::CPAN

B<Get:> 1) $self 2) $cookies - HTTP::Response object

B<Return:> -

The method checks that there was no error in accessing some page. If there was
error, the die is performed.

=end comment

=head1 TODO

 view release on metacpan or  search on metacpan

t/0002-debug.t  view on Meta::CPAN

# functional tests
is($debug, $clone,                  'test for a singleton object');
ok($debug->logger->debug('foo'),    'print a message of priority DEBUG');
ok($debug->logger->info('foo'),     'print a message of priority INFO');
ok($debug->logger->warn('foo'),     'print a message of priority WARN');
ok($debug->logger->error('foo'),    'print a message of priority ERROR');
ok($debug->logger->fatal('foo'),    'print a message of priority FATAL');

done_testing;

 view release on metacpan or  search on metacpan

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

has 'tools_uri' => (is => 'ro', default => TOOLS_URI);
has 'dig_uri'   => (is => 'ro', default => DIG_URI);
has 'mtr_uri'   => (is => 'ro', default => MTR_URI);
has 'loc_uri'   => (is => 'ro', default => LOC_URI);
has 'baseurl'   => (is => 'rw', trigger => \&Akamai::Open::Debug::debugger);
has 'last_error'=> (is => 'rw');

sub validate_base_url {
    my $self = shift;
    my $base = $self->baseurl();
    $self->debug->logger->debug('validating baseurl');

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

    my $data;

    $self->debug->logger->debug('dig() was called');

    unless(ref($param)) {
        $self->last_error('parameter of dig() has to be a hashref');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    unless(defined($param->{'hostname'}) && defined($param->{'queryType'})) {
        $self->last_error('hostname and queryType are mandatory options for dig()');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    unless($param->{'queryType'} =~ m/$valid_types_re/) {
        $self->last_error('queryType has to be one of A, AAAA, PTR, SOA, MX or CNAME');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    unless(defined($param->{'location'}) || defined($param->{'sourceIp'})) {
        $self->last_error('either location or sourceIp has to be set');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    $self->request->uri->query_form($param);
    $self->sign_request();

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

    $self->debug->logger->info(sprintf('HTTP response code for dig() call is %s', $self->response->code()));
    $data = decode_json($self->response->content());
    given($self->response->code()) {
        when($_ == 200) {
            if(defined($data->{'dig'}->{'errorString'})) {
                $self->last_error($data->{'dig'}->{'errorString'});
                $self->debug->logger->error($self->last_error());
                return(undef);
            } else {
                return($data->{'dig'});
            }
        }
        when($_ =~m/^5\d\d/) {
            $self->last_error('the server returned a 50x error');
            $self->debug->logger->error($self->last_error());
            return(undef);
        }
    }
    $self->last_error(sprintf('%s %s %s', $data->{'httpStatus'} ,$data->{'title'} ,$data->{'problemInstance'}));
    $self->debug->logger->error($self->last_error());
    return(undef);
}

sub mtr {
    my $self = shift;

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

    my $data;

    $self->debug->logger->debug('mtr() was called');

    unless(ref($param)) {
        $self->last_error('parameter of mtr() has to be a hashref');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    unless(defined($param->{'destinationDomain'})) {
        $self->last_error('destinationDomain is a mandatory options for mtr()');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    unless(defined($param->{'location'}) || defined($param->{'sourceIp'})) {
        $self->last_error('either location or sourceIp has to be set');
        $self->debug->logger->error($self->last_error());
        return(undef);
    }

    $self->request->uri->query_form($param);
    $self->sign_request();

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

    $self->debug->logger->info(sprintf('HTTP response code for mtr() call is %s', $self->response->code()));
    $data = decode_json($self->response->content());
    given($self->response->code()) {
        when($_ == 200) {
            if(defined($data->{'mtr'}->{'errorString'})) {
                $self->last_error($data->{'mtr'}->{'errorString'});
                $self->debug->logger->error($self->last_error());
                return(undef);
            } else {
                return($data->{'mtr'});
            }
        }
        when($_ =~m/^5\d\d/) {
            $self->last_error('the server returned a 50x error');
            $self->debug->logger->error($self->last_error());
            return(undef);
        }
    }
    $self->last_error(sprintf('%s %s %s', $data->{'httpStatus'} ,$data->{'title'} ,$data->{'problemInstance'}));
    $self->debug->logger->error($self->last_error());
    return(undef);
}

sub locations {
    my $self = shift;

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

    $self->response($self->user_agent->request($self->request()));
    $self->debug->logger->info(sprintf('HTTP response code for locations() call is %s', $self->response->code()));
    $data = decode_json($self->response->content());
    given($self->response->code()) {
        when($_ == 200) {
            if(defined($data->{'errorString'})) {
                $self->last_error($data->{'errorString'});
                $self->debug->logger->error($self->last_error());
                return(undef);
            } else {
                return($data->{'locations'});
            }
        }
        when($_ =~m/^5\d\d/) {
            $self->last_error('the server returned a 50x error');
            $self->debug->logger->error($self->last_error());
            return(undef);
        }
    }
    $self->last_error(sprintf('%s %s %s', $data->{'httpStatus'} ,$data->{'title'} ,$data->{'problemInstance'}));
    $self->debug->logger->error($self->last_error());
    return(undef);
}

1;

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

To initiate diagnostinc actions inside the Akamai network, you'll
need the information about the locations from which diagnostic 
actions are available.

I<locations()> provides the informations. On success it returns a 
Perl-style array reference. On error it returns I<undef> and sets 
the I<last_error()> appropriate.

=head2 $diag->mtr($hash_ref)

I<mtr()> returns a network trace like the well know I<mtr> Unix command.

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

A Akamai Server IP you want to run mtr from. This paramter is optional. 
Either location or sourceIp has to be passed to I<mtr()>

=back

On success it returns a Perl-style hash reference. On error it returns 
I<undef> and sets the I<last_error()> appropriate.

The hash reference has the following format:

  {
     'source' => ...,
     'packetLoss' => '...',
     'destination' => '...',
     'errorString' => ...,
     'analysis' => '...',
     'host' => '...',
     'avgLatency' => '...',
     'hops' => [
                 {

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

A Akamai Server IP you want to run dig from. This paramter is optional. 
Either location or sourceIp has to be passed to I<dig()>

=back

On success it returns a Perl-style hash reference. On error it returns 
I<undef> and sets the I<last_error()> appropriate.

The hash reference has the following format:

  {
      'authoritySection' => [

lib/Akamai/Open/DiagnosticTools.pm  view on Meta::CPAN

                             'ttl' => '...',
                             'preferenceValues' => ...,
                             'recordClass' => '...'
                           }
                         ],
      'errorString' => ...,
      'queryType' => '...',
      'hostname' => '...',
      'result' => '...'
  }

=head2 $diag->last_error()

Just returns the last occured error.

=head1 AUTHOR

Martin Probst <internet+cpan@megamaddin.org>

 view release on metacpan or  search on metacpan

lib/Akamai/PropertyFetcher.pm  view on Meta::CPAN

                $pm->finish;
            }
        } elsif ($properties_resp->code == 403 || $properties_resp->code == 404) {
            warn "Error retrieving property list (Contract ID: $contract_id, Group ID: $group_id): " . $properties_resp->status_line . " - Skipping\n";
        } else {
            die "Unexpected error (Contract ID: $contract_id, Group ID: $group_id): " . $properties_resp->status_line;
        }
    }
}