Result:
found more than 407 distributions - search limited to the first 2001 files matching your query
( run in 1.282 )
API-Drip-Request
view release on metacpan or search on metacpan
lib/API/Drip/Request.pm view on Meta::CPAN
Also accepts:
=over
=item debugger
A codref that should accept a list of diagnostic strings and log them somewhere
useful for debugging purposes. Only used when DRIP_DEBUG is true.
=back
=cut
my $config_validator = validation_for(
params => {
DRIP_CLIENT_CONF => { type => Str(), optional => 1 },
map { $_ => { type => Str(), optional => 1 } } keys %DEFAULTS,
debugger => { type => CodeRef(), optional => 1 },
}
);
sub new {
my $class = shift;
lib/API/Drip/Request.pm view on Meta::CPAN
# At this point, all configuration values should be set
foreach my $key ( keys %DEFAULTS ) {
confess "Missing configuration $key" unless defined $self->{$key};
}
$self->{debugger} = _mk_debugger( $self, %OPT );
bless $self, $class;
return $self;
}
sub _mk_debugger {
my ($self, %OPT) = @_;
unless ($self->{DRIP_DEBUG}) { return sub {}; }
if ( $OPT{debugger} ) { return $OPT{debugger} }
return sub { warn join "\n", map { ref($_) ? np $_ : $_ } @_ };
}
=head2 do_request
lib/API/Drip/Request.pm view on Meta::CPAN
my ($method, $endpoint, $content) = $request_validator->(@_);
my $uri = URI->new($self->{DRIP_URI});
$uri->path_segments( $uri->path_segments, $self->{DRIP_ID}, split( '/', $endpoint) );
$self->{debugger}->( 'Requesting: ' . $uri->as_string );
my $request = HTTP::Request->new( $method => $uri->as_string, );
if ( ref($content) ) {
$request->content_type('application/vnd.api+json');
$request->content( encode_json( $content ) );
}
lib/API/Drip/Request.pm view on Meta::CPAN
$self->{agent} //= LWP::UserAgent->new( agent => $self->{DRIP_AGENT} );
my $result = $self->{agent}->request( $request );
unless ( $result->is_success ) {
$self->{debugger}->("Request failed", $result->content);
die $result;
}
if ( $result->code == 204 ) {
$self->{debugger}->("Success, no content");
return undef;
}
my $decoded = eval {decode_json( $result->content )};
if ( $@ ) {
$self->{debugger}->('Failed to decode JSON:', $@, $result->content);
die $result;
}
return $decoded;
}
lib/API/Drip/Request.pm view on Meta::CPAN
Defaults to "API::Drip". Specifies the HTTP Agent header.
=item * DRIP_DEBUG (optional)
Defaults to 0. Set to a true value to enable debugging.
=cut
sub _load_conf {
my $OPT = shift();
API-Facebook
view release on metacpan or search on metacpan
lib/API/Facebook.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
access_token => $self->access_token,
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
identifier => $self->identifier,
lib/API/Facebook.pm view on Meta::CPAN
my $facebook = API::Facebook->new(
access_token => 'ACCESS_TOKEN',
identifier => 'IDENTIFIER',
);
$facebook->debug(1);
$facebook->fatal(1);
my $feed = $facebook->me('feed');
my $results = $feed->fetch;
lib/API/Facebook.pm view on Meta::CPAN
$facebook->identifier;
$facebook->identifier('IDENTIFIER');
The identifier attribute should be set to a string that identifies your app.
=head2 debug
$facebook->debug;
$facebook->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$facebook->fatal;
$facebook->fatal(1);
API-Github
view release on metacpan or search on metacpan
lib/API/Github.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
identifier => $self->identifier,
lib/API/Github.pm view on Meta::CPAN
username => 'USERNAME',
token => 'TOKEN',
identifier => 'APPLICATION NAME',
);
$github->debug(1);
$github->fatal(1);
my $user = $github->users('h@x0r');
my $results = $user->fetch;
lib/API/Github.pm view on Meta::CPAN
$github->username;
$github->username('USERNAME');
The username attribute should be set to the API user's username.
=head2 debug
$github->debug;
$github->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$github->fatal;
$github->fatal(1);
API-Google
view release on metacpan or search on metacpan
lib/API/Google.pm view on Meta::CPAN
$h->{tokensfile} = Config::JSON->new($params->{tokensfile});
} else {
die 'no json file specified!';
}
$h->{ua} = Mojo::UserAgent->new();
$h->{debug} = $params->{debug};
$h->{max_refresh_attempts} = $params->{max_refresh_attempts} || 5;
return bless $h, $class;
}
sub refresh_access_token {
my ($self, $params) = @_;
warn "Attempt to refresh access_token with params: ".Dumper $params if $self->{debug};
$params->{grant_type} = 'refresh_token';
$self->{ua}->post('https://www.googleapis.com/oauth2/v4/token' => form => $params)->res->json; # tokens
};
lib/API/Google.pm view on Meta::CPAN
my $tokens = $self->refresh_access_token({
client_id => $self->client_id,
client_secret => $self->client_secret,
refresh_token => $self->get_refresh_token_from_storage($user)
});
warn "New tokens got" if $self->{debug};
my $res = {};
$res->{old} = $self->get_access_token_from_storage($user);
warn Dumper $tokens if $self->{debug};
if ($tokens->{access_token}) {
$self->set_access_token_to_storage($user, $tokens->{access_token});
}
$res->{new} = $self->get_access_token_from_storage($user);
return $res;
};
sub get_refresh_token_from_storage {
my ($self, $user) = @_;
warn "get_refresh_token_from_storage(".$user.")" if $self->{debug};
return $self->{tokensfile}->get('gapi/tokens/'.$user.'/refresh_token');
};
sub get_access_token_from_storage {
my ($self, $user) = @_;
lib/API/Google.pm view on Meta::CPAN
sub build_http_transaction {
my ($self, $params) = @_;
warn "build_http_transaction() params : ".Dumper $params if $self->{debug};
my $headers = $self->build_headers($params->{user});
my $http_method = $params->{method};
my $tx;
lib/API/Google.pm view on Meta::CPAN
sub api_query {
my ($self, $params, $payload) = @_;
warn "api_query() params : ".Dumper $params if $self->{debug};
$payload = { payload => $payload };
%$params = (%$params, %$payload);
my $tx = $self->build_http_transaction($params);
my $res = $self->{ua}->start($tx)->res->json;
# for future:
# if ( grep { $_->{message} eq 'Invalid Credentials' && $_->{reason} eq 'authError'} @{$res->{error}{errors}} ) { ... }
warn "First api_query() result : ".Dumper $res if $self->{debug};
if (defined $res->{error}) { # token expired error handling
my $attempt = 1;
while ($res->{error}{message} eq 'Invalid Credentials') {
if ($attempt == $self->{max_refresh_attempts}) {
last;
}
warn "Seems like access_token was expired. Attemptimg update it automatically ..." if $self->{debug};
$self->refresh_access_token_silent($params->{user});
$tx = $self->build_http_transaction($params);
$res = $self->{ua}->start($tx)->res->json;
$attempt++;
}
API-Handle
view release on metacpan or search on metacpan
lib/API/Handle.pm view on Meta::CPAN
);
has _printer => (
is => 'rw'
, isa => 'Nour::Printer'
, handles => [ qw/verbose debug info warn warning error fatal dumper/ ]
, required => 1
, lazy => 1
, default => sub {
my $self = shift;
my %conf = $self->config->{printer} ? %{ $self->config->{printer} } : (
timestamp => 1
, verbose => 1
, dumper => 1
, debug => 1
, pid => 1
);
require Nour::Printer;
return new Nour::Printer ( %conf );
}
API-INSEE-Sirene
view release on metacpan or search on metacpan
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $self = bless {
credentials => $credentials,
user_agent => undef,
token_expiration => undef,
max_results => undef,
debug_mode => 0,
current_endpoint => undef,
}, $class;
$self->_initUserAgent();
$self->setProxy($proxy);
lib/API/INSEE/Sirene.pm view on Meta::CPAN
$max_results //= DEFAULT_MAX_RESULTS;
$self->{'max_results'} = $max_results > HARD_MAX_RESULTS ? HARD_MAX_RESULTS : $max_results;
}
sub setDebugMode {
my ($self, $debug_value) = @_;
$self->{'debug_mode'} = $debug_value;
}
sub setProxy {
my ($self, $proxy) = @_;
lib/API/INSEE/Sirene.pm view on Meta::CPAN
else {
$request = POST join('/', API_BASE_URL, $self->{'current_endpoint'}),
Content => [ %{ $parameters } ];
}
if ($self->{'debug_mode'}) { # Requests will not be sent in debug mode
return 0, $self->_dumpRequest($request);
}
if (!defined $self->{'token_expiration'} || $self->{'token_expiration'} < time) {
my ($err, $msg) = $self->_getToken();
lib/API/INSEE/Sirene.pm view on Meta::CPAN
Used to specifie the reached API endpoint.
=head2 setDebugMode
Enables the debug mode. When enabled, all the requests built by the module are displayed instead of being sent.
$sirene->setDebugMode(1);
=head2 setMaxResults
API-Instagram
view release on metacpan or search on metacpan
lib/API/Instagram.pm view on Meta::CPAN
has _obj_cache => ( is => 'ro', default => sub { { User => {}, Media => {}, Location => {}, Tag => {}, 'Media::Comment' => {} } } );
has _endpoint_url => ( is => 'ro', default => sub { 'https://api.instagram.com/v1' } );
has _authorize_url => ( is => 'ro', default => sub { 'https://api.instagram.com/oauth/authorize' } );
has _access_token_url => ( is => 'ro', default => sub { 'https://api.instagram.com/oauth/access_token' } );
has _debug => ( is => 'rw', lazy => 1 );
my $instance;
sub BUILD { $instance = shift }
sub instance { $instance //= shift->new(@_) }
lib/API/Instagram.pm view on Meta::CPAN
$uri->path_segments( $uri->path_segments, split '/', $url );
$uri->query_form($params);
$url = $uri->as_string;
}
# For debugging purposes
print "Requesting: $url$/" if $self->_debug;
# Treats response content
my $res = decode_json $self->_ua->$method( $url, [], $params )->decoded_content;
# Verifies meta node
API-MikroTik
view release on metacpan or search on metacpan
lib/API/MikroTik.pm view on Meta::CPAN
Subscribe to an output of commands with continuous responses such as C<listen> or
C<ping>. Should be terminated with L</cancel>.
=head1 DEBUGGING
You can set the API_MIKROTIK_DEBUG environment variable to get some debug output
printed to stderr.
Also, you can change connection timeout with the API_MIKROTIK_CONNTIMEOUT variable.
=head1 COPYRIGHT AND LICENSE
API-Name
view release on metacpan or search on metacpan
lib/API/Name.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
identifier => $self->identifier,
lib/API/Name.pm view on Meta::CPAN
user => 'USER',
token => 'TOKEN',
identifier => 'APPLICATION NAME',
);
$name->debug(1);
$name->fatal(1);
my $domain = $name->domains(get => 'example.com');
my $results = $domain->fetch;
lib/API/Name.pm view on Meta::CPAN
$name->identifier('IDENTIFIER');
The identifier attribute should be set to a string that identifies your
application.
=head2 debug
$name->debug;
$name->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$name->fatal;
$name->fatal(1);
API-Octopart
view release on metacpan or search on metacpan
lib/API/Octopart.pm view on Meta::CPAN
my $o = API::Octopart->new(
token => 'abcdefg-your-octopart-token-here',
cache => "$ENV{HOME}/.octopart/cache",
include_specs => 1,
ua_debug => 1,
query_limit => 10
);
# Query part stock:
my %opts = (
lib/API/Octopart.pm view on Meta::CPAN
=item * query_limit: die if too many API requests are made.
Defaults to no limit. I exhasted 20,000 queries very quickly due to a bug!
This might help with that, set to a reasonable limit while testing.
=item * ua_debug => 1
User Agent debugging. This is very verbose and provides API communication details.
=item * json_debug => 1
JSON response debugging. This is very verbose and dumps the Octopart response
in JSON.
=back
=cut
our %valid_opts = map { $_ => 1 } qw/token include_specs cache cache_age ua_debug query_limit json_debug/;
sub new
{
my ($class, %args) = @_;
foreach my $arg (keys %args)
lib/API/Octopart.pm view on Meta::CPAN
# Load the cached version if older than cache_age days.
my $age_days = (-M $hashfile);
if (-e $hashfile && $age_days < $self->{cache_age})
{
if ($self->{ua_debug})
{
print STDERR "Reading from cache file (age=$age_days days): $hashfile\n";
}
if (open(my $in, $hashfile))
lib/API/Octopart.pm view on Meta::CPAN
}
$self->{api_queries}++;
if ($self->{ua_debug})
{
$ua->add_handler(
"request_send",
sub {
my $msg = shift; # HTTP::Request
lib/API/Octopart.pm view on Meta::CPAN
$errors{$e->{message}}++;
}
die "Octopart: " . join("\n", keys(%errors)) . "\n";
}
if ($self->{json_debug})
{
if ($hashfile)
{
my $age_days = (-M $hashfile);
print STDERR "======= cache: $hashfile (age=$age_days days) =====\n"
API-ParallelsWPB
view release on metacpan or search on metacpan
lib/API/ParallelsWPB.pm view on Meta::CPAN
my $self = {
username => '',
password => '',
server => '',
api_version => '5.3',
debug => 0,
timeout => 30,
(@_)
};
map { confess "Field '" . $_ . "' required!" unless $self->{ $_ } } qw/username password server/;
lib/API/ParallelsWPB.pm view on Meta::CPAN
$req->authorization_basic( $self->{username}, $self->{password} );
$ua->ssl_opts( verify_hostname => 0 );
$ua->timeout( $self->{timeout} );
warn $req->as_string if ( $self->{debug} );
my $res = $ua->request( $req );
warn $res->as_string if ( $self->{debug} );
my $response = API::ParallelsWPB::Response->new( $res );
return $response;
}
lib/API/ParallelsWPB.pm view on Meta::CPAN
=item api_version
API version, used in API url constructing. Optional parameter.
=item debug
Debug flag, requests will be loogged to stderr. Optional parameter.
=item timeout
API-Plesk
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
username => '',
password => '',
secret_key => '',
url => '',
api_version => '1.6.3.1',
debug => 0,
timeout => 30,
(@_)
};
if (!$self->{secret_key}) {
lib/API/Plesk.pm view on Meta::CPAN
my $xml = { $operator => { $operation => $data } };
$xml = $self->render_xml($xml);
warn "REQUEST $operator => $operation\n$xml" if $self->{debug};
my ($response, $error) = $self->xml_http_req($xml);
warn "RESPONSE $operator => $operation => $error\n$response" if $self->{debug};
unless ( $error ) {
$response = xml2hash $response, array => [$operation, 'result', 'property'];
}
lib/API/Plesk.pm view on Meta::CPAN
$req->content($xml);
# LWP6 hack to prevent verification of hostname
$ua->ssl_opts(verify_hostname => 0) if $ua->can('ssl_opts');
warn $req->as_string if defined $self->{debug} && $self->{debug} > 1;
my $res = eval {
local $SIG{ALRM} = sub { die "connection timeout" };
alarm $self->{timeout};
$ua->request($req);
};
alarm 0;
warn $res->as_string if defined $self->{debug} && $self->{debug} > 1;
return ('', 'connection timeout')
if !$res || $@ || ref $res && $res->status_line =~ /connection timeout/;
return $res->is_success() ?
lib/API/Plesk.pm view on Meta::CPAN
my $api = API::Plesk->new(
username => 'user', # required
password => 'pass', # required
url => 'https://127.0.0.1:8443/enterprise/control/agent.php', # required
api_version => '1.6.3.1',
debug => 0,
timeout => 30,
);
my $res = $api->customer->get();
lib/API/Plesk.pm view on Meta::CPAN
password
url
Additional params:
api_version - default 1.6.3.1
debug - default 0
timeout - default 30 sec.
=item send($operator, $operation, $data, %params)
This method prepare and sends request to Plesk API.
API-PleskExpand
view release on metacpan or search on metacpan
t/TestData.pm view on Meta::CPAN
our %online_expand_valid_params = (
api_version => $ENV{'expand_api_version'} || '2.2.4.1',
username => $ENV{'expand_username'} || 'root',
password => $ENV{'expand_password'} || 'qwerty',
url => $ENV{'expand_url'} || $online_expand_url,
debug => '',
request_debug => '',
);
API-PureStorage
view release on metacpan or search on metacpan
lib/API/PureStorage.pm view on Meta::CPAN
$API::PureStorage::VERSION = '0.03';
our %ENV;
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
my $debug = 0;
sub new {
my $class = shift @_;
my $self = {
cookie_file => '/tmp/cookies.txt',
lib/API/PureStorage.pm view on Meta::CPAN
die "API returned error 500 for '$url' - $con\n";
}
if ( $num != 200 ) {
die "API returned code $num for URL '$url'\n";
}
print 'DEBUG: GET ', $url, ' -> ', $num, ":\n", Dumper(from_json($con)), "\n" if $debug;
return from_json($con);
}
sub _api_post {
my $self = shift @_;
lib/API/PureStorage.pm view on Meta::CPAN
die "API returned error 500 for '$url' - $con\n";
}
if ( $num != 200 ) {
die "API returned code $num for URL '$url'\n";
}
print 'DEBUG: POST ', $url, ' -> ', $num, ":\n", Dumper(from_json($con)), "\n" if $debug;
return from_json($con);
}
1;
__END__
API-Stripe
view release on metacpan or search on metacpan
lib/API/Stripe.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
identifier => $self->identifier,
lib/API/Stripe.pm view on Meta::CPAN
my $stripe = API::Stripe->new(
username => 'USERNAME',
identifier => 'APPLICATION NAME',
);
$stripe->debug(1);
$stripe->fatal(1);
my $charge = $stripe->charges('ch_163Gh12CVMZwIkvc');
my $results = $charge->fetch;
lib/API/Stripe.pm view on Meta::CPAN
$stripe->username;
$stripe->username('USERNAME');
The username attribute should be set to an API key associated with your account.
=head2 debug
$stripe->debug;
$stripe->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$stripe->fatal;
$stripe->fatal(1);
API-Trello
view release on metacpan or search on metacpan
lib/API/Trello.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
key => $self->key,
lib/API/Trello.pm view on Meta::CPAN
key => 'KEY',
token => 'TOKEN',
identifier => 'APPLICATION NAME',
);
$trello->debug(1);
$trello->fatal(1);
my $board = $trello->boards('4d5ea62fd76a');
my $results = $board->fetch;
lib/API/Trello.pm view on Meta::CPAN
$trello->identifier;
$trello->identifier('IDENTIFIER');
The identifier attribute should be set using a string to identify your app.
=head2 debug
$trello->debug;
$trello->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$trello->fatal;
$trello->fatal(1);
API-Twitter
view release on metacpan or search on metacpan
lib/API/Twitter.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
identifier => $self->identifier,
lib/API/Twitter.pm view on Meta::CPAN
access_token => 'ACCESS_TOKEN',
access_token_secret => 'ACCESS_TOKEN_SECRET',
identifier => 'IDENTIFIER',
);
$twitter->debug(1);
$twitter->fatal(1);
my $user = $twitter->users('lookup');
my $results = $user->fetch;
lib/API/Twitter.pm view on Meta::CPAN
$twitter->identifier;
$twitter->identifier('IDENTIFIER');
The identifier attribute should be set to a string that identifies your app.
=head2 debug
$twitter->debug;
$twitter->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$twitter->fatal;
$twitter->fatal(1);
API-Wunderlist
view release on metacpan or search on metacpan
lib/API/Wunderlist.pm view on Meta::CPAN
method resource (@segments) {
# build new resource instance
my $instance = __PACKAGE__->new(
debug => $self->debug,
fatal => $self->fatal,
retries => $self->retries,
timeout => $self->timeout,
user_agent => $self->user_agent,
identifier => $self->identifier,
lib/API/Wunderlist.pm view on Meta::CPAN
client_id => 'CLIENT_ID',
access_token => 'ACCESS_TOKEN',
identifier => 'APPLICATION NAME',
);
$wunderlist->debug(1);
$wunderlist->fatal(1);
my $list = $wunderlist->lists('12345');
my $results = $list->fetch;
lib/API/Wunderlist.pm view on Meta::CPAN
$wunderlist->identifier;
$wunderlist->identifier('IDENTIFIER');
The identifier attribute should be set to a string that identifies your app.
=head2 debug
$wunderlist->debug;
$wunderlist->debug(1);
The debug attribute if true prints HTTP requests and responses to standard out.
=head2 fatal
$wunderlist->fatal;
$wunderlist->fatal(1);
APNS-Agent
view release on metacpan or search on metacpan
lib/APNS/Agent.pm view on Meta::CPAN
new => 1,
ro => [qw/
certificate
private_key
sandbox
debug_port
/],
ro_lazy => {
on_error_response => sub {
sub {
my $self = shift;
lib/APNS/Agent.pm view on Meta::CPAN
state => $state,
token => $data->{token},
payload => $data->{payload},
});
},
($self->debug_port ? (debug_port => $self->debug_port) : ()),
);
}
sub _apns {
my $self = shift;
lib/APNS/Agent.pm view on Meta::CPAN
$p->getoptionsfromarray(\@argv, \my %opt, qw/
certificate=s
private-key=s
disconnect-interval=i
sandbox!
debug-port=i
/) or Pod::Usage::pod2usage();
Pod::Usage::pod2usage() if !$opt{certificate} || !$opt{'private-key'};
Hash::Rename::hash_rename(\%opt, code => sub {tr/-/_/});
(\%opt, \@argv);
APP-REST-RestTestSuite
view release on metacpan or search on metacpan
script/rest-client view on Meta::CPAN
'c|configfile=s' => \$config_file,
'l|logdir=s' => \$log_dir,
'r|run-test-suite' => \$action->{runtestsuite},
't|test-load=s' => \$action->{testload},
's|get-sample-config' => \$action->{getsampleconfig},
'd|debug' => \$action->{debug},
'h|help' => \&usage,
'V|version' =>
sub { print "Version : ", APP::REST::RestTestSuite->VERSION, "\n"; exit; },
);
script/rest-client view on Meta::CPAN
HELP
}
$suite = new APP::REST::RestTestSuite();
}
if ( $action->{debug} ) {
print Dumper $suite;
exit;
} elsif ( $action->{runtestsuite} ) {
APR-HTTP-Headers-Compat
view release on metacpan or search on metacpan
- Initial release.
0.02 2009-06-12
- Expanded on documentation
- Removed a couple of errant $DB::single = 1 statements. Mad
debugging skilz.
ARCv2
view release on metacpan or search on metacpan
$DefaultPIDFile = "/var/run/arcxd.pid";
$Copyright = "ARCv2 $VERSION (C) 2003-5 Patrick Boettcher and others. All right reserved.";
$Contact = "Patrick Boettcher <patrick.boettcher\@desy.de>, Wolfgang Friebel <wolfgang.friebel\@desy.de>";
my @syslog_arr = ('emerg','alert','crit','err','warning','notice','info','debug');
# package member vars
sub members
{
return {
## Log function.
## Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
## loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
## LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
## LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
## information), LOG_DEBUG (verbose debug information). It possible to combine the
## levels with or (resp. +) to allow a message to appear when not all loglevels are
## requested by the user.
## Commonly used for logging errors from application level.
##in> $facility, ... (message)
##out> always false
{
my $this = shift;
my $pr = shift;
my $ll = $this->{loglevel};
my $lev = 1;
my @syslog_arr = ('err','info','debug');
$lev = 0 if $pr & LOG_ERR;
$lev = 2 if $pr & LOG_DEBUG;
if ($pr & $this->{loglevel}) {
ARS-Simple
view release on metacpan or search on metacpan
lib/ARS/Simple.pm view on Meta::CPAN
$self->{server} = $args->{server} if $args->{server};
$self->{log} = $args->{log} if $args->{log};
$self->{max_returns} = $args->{max_returns} if defined $args->{max_returns};
$self->{reset_limit} = $args->{reset_limit} if defined $args->{reset_limit};
if ($args->{ars_debug})
{
$ARS::DEBUGGING = 1;
}
$self->{debug} = $args->{debug} ? 1 : 0;
## Now connect to Remedy
if ($self->{server} && $user && $pword)
{
my $ctl = ars_Login($self->{server}, $user, $pword);
lib/ARS/Simple.pm view on Meta::CPAN
Example usage:
reset_limit => 3000, # max returns back to a suitable maximum of 3000
=item ars_debug
Turn on, if true (1), the ARSperl debugging output.
Not something you would normally use.
=item log
Pass a object to use to log erros/information to a log file.
lib/ARS/Simple.pm view on Meta::CPAN
user => 'some_admin',
password => 'password_for_some_admin',
log => $log,
max_returns => 0, # allow unlimited returns
reset_limit => 3000, # reset to a suitable limit after each call using max_returns
ars_debug => 1, # get a whole lot of debugging information (you real should not need)
});
=head2 get_list
Method to return an array reference of Entry-Id values for a form.
ARSperl
view release on metacpan or search on metacpan
my(%mTypes) = ( 0 => "OK", 1 => "WARNING", 2 => "ERROR", 3 => "FATAL",
4 => "INTERNAL ERROR",
-1 => "TRACEBACK");
for($i = 0; $i < $ARS::ars_errhash{numItems}; $i++) {
# If debugging is not enabled, don't show traceback messages
if($ARS::DEBUGGING == 1) {
$s .= sprintf("[%s] %s (ARERR \#%d)",
$mTypes{@{$ARS::ars_errhash{messageType}}[$i]},
@{$ARS::ars_errhash{messageText}}[$i],
ASNMTAP
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
my $doCgisess = 1; # default
my $doReports = 1; # default
my $doDatabase = 0; # default
my $doYearsAgo = -1; # default
my $doForce = 0; # default
my $debug = 0; # default
#------------------------------------------------------------------------
# Don't edit below here unless you know what you are doing. -------------
#------------------------------------------------------------------------
applications/archive.pl view on Meta::CPAN
"r:s" => \$opt_r, "reports:s" => \$opt_r,
"d:s" => \$opt_d, "database:s" => \$opt_d,
"y:s" => \$opt_y, "yearsago:s" => \$opt_y,
"f:s" => \$opt_f, "force:s" => \$opt_f,
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
"D:s" => \$opt_D, "debug:s" => \$opt_D,
"V" => \$opt_V, "version" => \$opt_V,
"h" => \$opt_h, "help" => \$opt_h
);
if ($opt_V) { print_revision($PROGNAME, $version); exit $ERRORS{OK}; }
applications/archive.pl view on Meta::CPAN
}
}
if ($opt_D) {
if ($opt_D eq 'F' || $opt_D eq 'T' || $opt_D eq 'L') {
$debug = 0 if ($opt_D eq 'F');
$debug = 1 if ($opt_D eq 'T');
$debug = 2 if ($opt_D eq 'L');
} else {
usage("Invalid debug: $opt_D\n");
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my $logger = LOG_init_log4perl ( 'archive', undef, $debug );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my @archivelisttable;
if ( $debug ) {
print "Current day : <", scalar(localtime($currentEpoch)), "><", $currentEpoch, ">\n";
print "Yesterday : <", scalar(localtime($yesterdayEpoch)), "><", $yesterdayEpoch, ">\n";
print "First day of yesterday week : <", scalar(localtime($firstDayOfWeekEpoch)), "><", $firstDayOfWeekEpoch, ">\n";
print "GZIP not debug files older then : <", scalar(localtime($gzipEpoch)), "><", $gzipEpoch, ">\n";
print "GZIP debug files older then : <", scalar(localtime($gzipDebugEpoch)), "><", $gzipDebugEpoch, ">\n";
print "Remove All/Nok files older then : <", scalar(localtime($removeAllNokEpoch)), "><", $removeAllNokEpoch, ">\n";
print "Remove GZIP files older then : <", scalar(localtime($removeGzipEpoch)), "><", $removeGzipEpoch, ">\n";
print "Remove Debug files older then : <", scalar(localtime($removeDebugEpoch)), "><", $removeDebugEpoch, ">\n";
print "Remove Week files older then : <", scalar(localtime($removeWeeksEpoch)), "><", $removeWeeksEpoch, ">\n";
print "Remove Cgisess files older then : <", scalar(localtime($removeCgisessEpoch)), "><", $removeCgisessEpoch, ">\n";
print "Remove Report files older then : <", scalar(localtime($removeReportsEpoch)), "><", $removeReportsEpoch, ">\n";
}
my ($emailReport, $rvOpen) = init_email_report (*EMAILREPORT, "archiverEmailReport.txt", $debug);
if ( $rvOpen ) {
@archivelisttable = read_table($prgtext, $archivelist, 0, $debug) if (defined $archivelist);
doBackupCsvSqlErrorWeekDebugReport ($RESULTSPATH, $DEBUGDIR, $REPORTDIR, $gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeReportsEpoch, $removeWeeksEpoch, $firstDayOfWeekEpoch, $yesterdayEpoch, $currentEpoch) if ($doRepor...
createCommentsAndEventsArchiveTables ( "-$doYearsAgo year" ) if ($doYearsAgo != -1);
if ($doDatabase) {
applications/archive.pl view on Meta::CPAN
}
removeCgisessFiles ($removeCgisessEpoch) if ($doCgisess);
my $emailreport = "\nRemove *-MySQL-sql-error.txt:\n-----------------------------\n";
if ( $debug ) { print "$emailreport"; } else { print EMAILREPORT "$emailreport"; }
my @sqlErrorTxtFiles = glob("$RESULTSPATH/*-MySQL-sql-error.txt");
foreach my $sqlErrorTxtFile (@sqlErrorTxtFiles) {
if ($debug) {
print "E- unlink <$sqlErrorTxtFile>\n";
} else {
print EMAILREPORT "E- unlink <$sqlErrorTxtFile>\n";
}
applications/archive.pl view on Meta::CPAN
}
} else {
print "Cannot open $emailReport to print email report information\n";
}
my ($rc) = send_email_report (*EMAILREPORT, $emailReport, $rvOpen, $prgtext, $debug);
exit;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub archiveCommentsAndEventsTables {
my ($eventsAgo, $commentsAgo) = @_;
print EMAILREPORT "\nArchive '$SERVERTABLCOMMENTS' and '$SERVERTABLEVENTS' tables:\n--------------------------------------------------\n" unless ( $debug );
# Init parameters
my ($rv, $dbh, $sth, $sql, $year, $month, $day, $timeslot, $yearMOVE, $monthMOVE, $sqlMOVE, $sqlUPDATE);
$rv = 1;
$dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
if ($dbh and $rv) {
$year = get_year ($eventsAgo);
$month = get_month ($eventsAgo);
$day = get_day ($eventsAgo);
$timeslot = timelocal ( 0, 0, 0, $day, ($month-1), ($year-1900) );
if ($debug) {
$sql = "select SQL_NO_CACHE catalogID, id, endDate, startDate, timeslot, uKey from $SERVERTABLEVENTS force index (key_timeslot) where timeslot < '" .$timeslot. "'";
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot', Date: " .scalar(localtime($timeslot)). "\n<$sql>\n";
} else {
$sql = "select SQL_NO_CACHE catalogID, id, endDate from $SERVERTABLEVENTS force index (key_timeslot) where timeslot < '" .$timeslot. "'";
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot'\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
($yearMOVE, $monthMOVE, undef) = split (/-/, $ref->{endDate});
print "\n", $ref->{catalogID}, " ", $ref->{id}, " ", $ref->{uKey}, " ", $ref->{startDate}, " ", $ref->{endDate}, " ",$ref->{timeslot}, " \n" if ($debug);
$sqlMOVE = 'REPLACE INTO `' .$SERVERTABLEVENTS. '_' .$yearMOVE. '_' .$monthMOVE. '` SELECT * FROM `' .$SERVERTABLEVENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
if ( $yearMOVE ne '0000' and $monthMOVE ne '00' ) {
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
if ( $rv ) {
$sqlMOVE = 'DELETE FROM `' .$SERVERTABLEVENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
}
} else {
if ($debug) {
print "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLEVENTS}_${yearMOVE}_${monthMOVE}' not possible for '$sqlMOVE'\n";
} else {
print EMAILREPORT "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLEVENTS}_${yearMOVE}_${monthMOVE}' not possible for '$sqlMOVE'\n";
}
}
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
$sql = "select SQL_NO_CACHE distinct $SERVERTABLCOMMENTS.catalogID, $SERVERTABLCOMMENTS.uKey, $SERVERTABLCOMMENTS.commentData from $SERVERTABLCOMMENTS, $SERVERTABLPLUGINS, $SERVERTABLVIEWS, $SERVERTABLDISPLAYDMNS, $SERVERTABLCRONTABS as crontabOu...
if ($debug) {
print "\nUpdate table '$SERVERTABLCOMMENTS': <$sql>\n";
} else {
print EMAILREPORT "\nUpdate table '$SERVERTABLCOMMENTS': <$sql>\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
my ($localYear, $localMonth, $currentYear, $currentMonth, $currentDay, $currentHour, $currentMin, $currentSec) = ((localtime)[5], (localtime)[4], ((localtime)[5] + 1900), ((localtime)[4] + 1), (localtime)[3,2,1,0]);
my $solvedDate = "$currentYear-$currentMonth-$currentDay";
my $solvedTime = "$currentHour:$currentMin:$currentSec";
my $solvedTimeslot = timelocal($currentSec, $currentMin, $currentHour, $currentDay, $localMonth, $localYear);
while (my $ref = $sth->fetchrow_hashref()) {
$sqlUPDATE = 'UPDATE ' .$SERVERTABLCOMMENTS. ' SET replicationStatus="U", problemSolved="1", solvedDate="' .$solvedDate. '", solvedTime="' .$solvedTime. '", solvedTimeslot="' .$solvedTimeslot. '", commentData="' .$ref->{commentData}. '<br>AUT...
print "$sqlUPDATE;\n" if ($debug);
$dbh->do( $sqlUPDATE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
$year = get_year ($commentsAgo);
$month = get_month ($commentsAgo);
$day = get_day ($commentsAgo);
$timeslot = timelocal ( 0, 0, 0, $day, ($month-1), ($year-1900) );
$sql = "select SQL_NO_CACHE catalogID, id, solvedDate, solvedTimeslot, uKey from $SERVERTABLCOMMENTS force index (solvedTimeslot) where problemSolved = '1' and solvedTimeslot < '" .$timeslot. "'";
if ($debug) {
print "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot', Date: " .scalar(localtime($timeslot)). "\n<$sql>\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot'\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
($yearMOVE, undef, undef) = split (/-/, $ref->{solvedDate});
print "\n", $ref->{catalogID}, " ", $ref->{id}, " ", $ref->{uKey}, " ", $ref->{solvedDate}, " ", $ref->{solvedTimeslot}, "\n" if ($debug);
$sqlMOVE = 'REPLACE INTO `' .$SERVERTABLCOMMENTS. '_' .$yearMOVE. '` SELECT * FROM `' .$SERVERTABLCOMMENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
if ( $yearMOVE ne '0000' ) {
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
if ( $rv ) {
$sqlMOVE = 'DELETE FROM `' .$SERVERTABLCOMMENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
}
} else {
if ($debug) {
print "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLCOMMENTS}_${yearMOVE}' not possible for '$sqlMOVE'\n";
} else {
print EMAILREPORT "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLCOMMENTS}_${yearMOVE}' not possible for '$sqlMOVE'\n";
}
}
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
# cleanup automatically scheduled donwtimes when sheduled OFFLINE
my ($localYear, $localMonth, $currentYear, $currentMonth, $currentDay, $currentHour, $currentMin, $currentSec) = ((localtime)[5], (localtime)[4], ((localtime)[5] + 1900), ((localtime)[4] + 1), (localtime)[3,2,1,0]);
my $solvedDate = "$currentYear-$currentMonth-$currentDay";
my $solvedTime = "$currentHour:$currentMin:$currentSec";
my $solvedTimeslot = timelocal($currentSec, $currentMin, $currentHour, $currentDay, $localMonth, $localYear);
my $sqlUPDATE = 'UPDATE ' .$SERVERTABLCOMMENTS. ' SET replicationStatus="U", problemSolved="1", solvedDate="' .$solvedDate. '", solvedTime="' .$solvedTime. '", solvedTimeslot="' .$solvedTimeslot. '" where catalogID="'. $CATALOGID. '" and problemS...
print "$sqlUPDATE\n" if ($debug);
$dbh->do ( $sqlUPDATE ) or $rv = errorTrapDBI("Cannot dbh->do: $sqlUPDATE", $debug) unless ( $debug );
$dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub checkTableDBI {
my ($dbh, $database, $table, $op, $msg_type, $msg_text) = @_;
print "-> <$database.$table>, <$op>, <$msg_type>, <$msg_text>\n" if ($debug);
my ($Table, $Op, $Msg_type, $Msg_text) = '';
my $rv = 1;
my $sql = "check table $table";
my $sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
$Table = $ref->{Table};
$Op = $ref->{Op};
$Msg_type = $ref->{Msg_type};
$Msg_text = $ref->{Msg_text};
print "<- <$Table>, <$Op>, <$Msg_type>, <$Msg_text>\n" if ($debug);
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
$rv = ($rv and "$database.$table" eq $Table and $op eq $Op and $msg_type eq $Msg_type and $msg_text eq $Msg_text) ? 1 : 0;
}
return ($rv);
}
applications/archive.pl view on Meta::CPAN
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub createCommentsAndEventsArchiveTables {
my ($daysBefore) = @_;
print EMAILREPORT "\nCreate '$SERVERTABLCOMMENTS' and '$SERVERTABLEVENTS' tables when needed:\n--------------------------------------------------\n" unless ( $debug );
# Init parameters
my ($rv, $dbh, $sql, $year, $month);
$year = get_year ($daysBefore);
$rv = 1;
$dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
if ($dbh and $rv) {
foreach $month ('01'..'12') {
$sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_'. $month .'` LIKE `'. $SERVERTABLEVENTS .'`';
$rv = ! checkTableDBI ($dbh, $DATABASE, $SERVERTABLEVENTS .'_'. $year .'_'. $month, 'check', 'status', 'OK');
if ($rv) {
if ($debug) {
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month'\n<$sql>\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ";
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
$rv = checkTableDBI ($dbh, $DATABASE, $SERVERTABLEVENTS .'_'. $year .'_'. $month, 'check', 'status', 'OK');
if ($rv) { print EMAILREPORT "Created\n"; } else { print EMAILREPORT "NOT CREATED, PLEASE VERIFY\n"; }
}
} else {
$rv = 1;
print "Table: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ALREADY CREATED\n" if ($debug);
}
if ( $SERVERMYSQLMERGE eq '1' ) {
if ($debug) {
print "Table: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ENGINE\n";
} else {
print EMAILREPORT "Table: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ENGINE\n";
$sql = sprintf ("ALTER TABLE `%s_%s_%02d` ENGINE = MyISAM", $SERVERTABLEVENTS, $year, $month);
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
if ($rv) { print EMAILREPORT "ENGINE = MyISAM\n\n"; } else { print EMAILREPORT "NOT ENGINE = MyISAM, PLEASE VERIFY '$sql'\n\n"; }
}
}
}
if ( $SERVERMYSQLMERGE eq '1' ) {
if ($debug) {
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Status: MERGE\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Status: MERGE\n";
$sql = 'DROP TABLE IF EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'`';
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
if ($rv) {
$sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'` LIKE `'. $SERVERTABLEVENTS .'_'. $year .'_01`';
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
}
if ($rv) {
$sql = 'ALTER TABLE `'. $SERVERTABLEVENTS .'_'. $year .'` ENGINE=MERGE UNION=(`'. $SERVERTABLEVENTS .'_'. $year .'_01`, `'. $SERVERTABLEVENTS .'_'. $year .'_02`, `'. $SERVERTABLEVENTS .'_'. $year .'_03`, `'. $SERVERTABLEVENTS .'_'. $year .'...
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
}
if ($rv) { print EMAILREPORT "MERGED\n\n"; } else { print EMAILREPORT "NOT MERGED, PLEASE VERIFY '$sql'\n\n"; }
}
foreach my $quarter (1..4) {
if ($debug) {
print "\nTable: '$SERVERTABLEVENTS', Year: '$year' Quarter: 'Q$quarter', Status: MERGE\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year' Quarter: 'Q$quarter', Status: MERGE\n";
$sql = 'DROP TABLE IF EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_Q'. $quarter .'`';
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
if ($rv) {
$sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_Q'. $quarter .'` LIKE `'. $SERVERTABLEVENTS .'_'. $year .'_'. sprintf ("%02d", ($quarter * 3 ) - 2) .'`';
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
}
if ($rv) {
$sql = 'ALTER TABLE `'. $SERVERTABLEVENTS .'_'. $year .'_Q'. $quarter .'` ENGINE=MERGE UNION=(`'. $SERVERTABLEVENTS .'_'. $year .'_'. sprintf ("%02d", ($quarter * 3 ) - 2) .'`, `'. $SERVERTABLEVENTS .'_'. $year .'_'. sprintf ("%02d", ($qu...
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
}
if ($rv) { print EMAILREPORT "MERGED\n\n"; } else { print EMAILREPORT "NOT MERGED, PLEASE VERIFY '$sql'\n\n"; }
}
}
applications/archive.pl view on Meta::CPAN
$sql = "CREATE TABLE IF NOT EXISTS `". $SERVERTABLCOMMENTS .'_'. $year ."` LIKE `$SERVERTABLCOMMENTS`";
$rv = ! checkTableDBI ($dbh, $DATABASE, $SERVERTABLCOMMENTS .'_'. $year, 'check', 'status', 'OK');
if ($rv) {
if ($debug) {
print "\nTable: '$SERVERTABLCOMMENTS', Year: '$year'\n<$sql>\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Status: ";
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
$rv = checkTableDBI ($dbh, $DATABASE, $SERVERTABLCOMMENTS .'_'. $year, 'check', 'status', 'OK');
if ($rv) { print EMAILREPORT "Created\n\n"; } else { print EMAILREPORT "NOT CREATED, PLEASE VERIFY\n\n"; }
}
} else {
print "Table: '$SERVERTABLCOMMENTS', Year: '$year', Status: ALREADY CREATED\n\n" if ($debug);
}
$dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub doBackupCsvSqlErrorWeekDebugReport {
my ($RESULTSPATH, $DEBUGDIR, $REPORTDIR, $gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeReportsEpoch, $removeWeeksEpoch, $firstDayOfWeekEpoch, $yesterdayEpoch, $currentEpoch) = @_;
print EMAILREPORT "\nDo backup, csv, sql, error, week, and debug files:\n--------------------------------------------------\n" unless ( $debug );
my ($darchivelist, $dtest, $pagedir, $ttest, $command, $rvOpendir, $path, $filename, $debugPath, $debugFilename, $reportPath, $reportFilename, $weekFilename);
my @files = ();
foreach $darchivelist (@archivelisttable) {
($pagedir, $ttest) = split(/\#/, $darchivelist, 2);
my @stest = split(/\|/, $ttest);
$path = $RESULTSPATH .'/'. $pagedir;
$debugPath = $path .'/'. $DEBUGDIR;
$reportPath = $path .'/'. $REPORTDIR;
if ($debug) {
print "\n", "<$RESULTSPATH><$pagedir><$path><$DEBUGDIR><$REPORTDIR>\n"
} else {
print EMAILREPORT "\nPlugin: '$ttest', results directory: '$path'\n";
}
applications/archive.pl view on Meta::CPAN
if ($rvOpendir) {
@files = readdir(DIR);
closedir(DIR);
}
if (-e $debugPath) {
$rvOpendir = opendir(DIR, $debugPath);
if ($rvOpendir) {
while ($debugFilename = readdir(DIR)) {
print "Debug Filename: <$debugFilename>\n" if ($debug >= 2);
gzipOrRemoveHttpDumpDebug ($gzipDebugEpoch, $removeDebugEpoch, $debugPath, $debugFilename);
}
closedir(DIR);
}
}
applications/archive.pl view on Meta::CPAN
if (-e $reportPath) {
$rvOpendir = opendir(DIR, $reportPath);
if ($rvOpendir) {
while ($reportFilename = readdir(DIR)) {
print "Report Filename: <$reportFilename>\n" if ($debug >= 2);
removeOldReportFiles ($removeReportsEpoch, $removeGzipEpoch, $reportPath, $reportFilename);
}
closedir(DIR);
}
applications/archive.pl view on Meta::CPAN
}
my ( $tWeek, $tYear ) = get_week('yesterday');
$weekFilename = get_year('yesterday') ."w$tWeek-$command-$catalogID_uKey-csv-week.txt";
if (-e "$path/$weekFilename") { unlink ($path.'/'.$weekFilename); }
print "Test : <$dtest>\n" if ($debug);
foreach $filename (@files) {
print "Filename : <$filename>\n" if ($debug >= 2);
catAllCsvFilesYesterdayWeek ($firstDayOfWeekEpoch, $yesterdayEpoch, $catalogID_uKey, $command, $path, $weekFilename, $filename);
removeAllNokgzipCsvSqlErrorWeekFilesOlderThenAndMoveToBackupShare ($gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeWeeksEpoch, $catalogID_uKey, $command, $path, $filename);
}
}
}
applications/archive.pl view on Meta::CPAN
my ($datum, $staart) = split(/\-/, $filename, 2);
if ( $staart ) {
if ( $staart eq "all.txt" ) {
if ($datum le get_yearMonthDay($removeAllNokEpoch)) {
if ($debug) {
print "A- <$datum><", get_yearMonthDay($removeAllNokEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "A- <$datum><", get_yearMonthDay($removeAllNokEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv.txt" ) {
if ($datum le get_yearMonthDay($gzipEpoch)) {
if ($debug) {
print "C+ <$datum><", get_yearMonthDay($gzipEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "C+ <$datum><", get_yearMonthDay($gzipEpoch), "> gzip <$path><$filename>\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
print EMAILREPORT "C+ E R R O R: <$stderr>\n" unless ( $status );
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv.txt.gz" ) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "C- <$datum><", get_yearMonthDay($removeGzipEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "C- <$datum><", get_yearMonthDay($removeGzipEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
applications/archive.pl view on Meta::CPAN
my $jaarWeekFilename = int($jaar.$week);
my ( $tWeek, $tYear ) = get_week ('yesterday');
my $jaarWeekYesterday = int(get_year('yesterday'). $tWeek);
if ( $jaarWeekFilename lt $jaarWeekYesterday ) {
if ($debug) {
print "CW+<$jaarWeekYesterday><$jaarWeekFilename><$path><$filename>\n";
} else {
print EMAILREPORT "CW+<$jaarWeekYesterday><$jaarWeekFilename> gzip <$path><$filename>\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
print EMAILREPORT "CW+ E R R O R: <$stderr>\n" unless ( $status );
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv-week.txt.gz" ) {
my ($jaar, $week) = split(/w/, $datum);
my $jaarWeekFilename = int($jaar.$week);
my ( $tWeek, $tYear ) = get_week ('-'. $removeGzipWeeksAgo. ' weeks');
my $jaarWeekRemove = int(get_year('-'. $removeGzipWeeksAgo. ' weeks') .$tWeek);
if ( $jaarWeekFilename le $jaarWeekRemove ) {
if ($debug) {
print "CW-<$jaarWeekRemove><$jaarWeekFilename><", get_yearMonthDay($removeWeeksEpoch), "<$path><$filename>\n";
} else {
print EMAILREPORT "CW-<$jaarWeekRemove><$jaarWeekFilename><", get_yearMonthDay($removeWeeksEpoch), " unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey.sql" ) {
if ($debug) {
print "S+ <$datum><", get_yearMonthDay($gzipEpoch), "><$path><$filename>\n" if ($datum le get_yearMonthDay($gzipEpoch));
} elsif (! $doDatabase) {
# APE # TODO - REMOVE
# Init parameters
# my ($rv, $dbh, $sql);
# open connection to database and query data
# $rv = 1;
# $dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
# if ($dbh and $rv) {
# $sql = "LOAD DATA LOW_PRIORITY LOCAL INFILE '$path/$filename' INTO TABLE $SERVERTABLEVENTS FIELDS TERMINATED BY ',' ENCLOSED BY '\"' LINES TERMINATED BY '\\n'";
# $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
# if ( $rv ) {
# my $mysqlInfo = $dbh->{mysql_info};
# my ($records, $deleted, $skipped, $warnings) = ($mysqlInfo =~ /^Records:\s+(\d+)\s+Deleted:\s+(\d+)\s+Skipped:\s+(\d+)\s+Warnings: (\d+)$/);
# if ($deleted eq '0' and $skipped eq '0' and $warnings eq '0') {
# print EMAILREPORT "S+ LOAD DATA ... : $records record(s) added for $filename\n";
# my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
# print EMAILREPORT "S+ E R R O R: <$stderr>\n" unless ( $status );
# } else {
# print EMAILREPORT "S+ LOAD DATA ... WARNING for $filename: $mysqlInfo, <$records> <$deleted> <$skipped> <$warnings>\n";
# rename("$path/$filename", "$path/$filename-LOAD-DATA-FAILED");
# }
# }
# $dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
# }
my $_debug = ( ( $debug eq 'T' ) ? 1 : 0);
my $dbh = CSV_prepare_table ("$path/", $filename, '', $SERVERTABLEVENTS, \@EVENTS, \%EVENTS, \$logger, $_debug);
my $rv = CSV_import_from_table (1, $dbh, $SERVERTABLEVENTS, \@EVENTS, 'id', $doForce, \$logger, $_debug);
if ( $rv ) {
if ($debug) {
print "S+ IMPORT CSV DATA ... OK: ALL records imported from $path/$filename\n";
} else {
print EMAILREPORT "S+ IMPORT CSV DATA ... OK: ALL records imported from $path/$filename\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
print EMAILREPORT "S+ E R R O R: <$stderr>\n" unless ( $status );
}
} else {
if ($debug) {
print "S- IMPORT CSV DATA ... CRITICAL: ZERO records imported from $path/$filename\n";
} else {
print EMAILREPORT "S- IMPORT CSV DATA ... CRITICAL: ZERO records imported from $path/$filename\n";
rename("$path/$filename", "$path/$filename-LOAD-DATA-FAILED");
}
}
CSV_cleanup_table ($dbh, \$logger, $_debug);
}
} elsif ( $staart eq "$command-$catalogID_uKey.sql.gz" ) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "S- <$datum><", get_yearMonthDay($removeGzipEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "S- <$datum><", get_yearMonthDay($removeGzipEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-sql-error.txt" ) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "SE-<$datum><", get_yearMonthDay($removeDebugEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "SE-<$datum><", get_yearMonthDay($removeDebugEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "nok.txt" ) {
if ($datum le get_yearMonthDay($removeAllNokEpoch)) {
if ($debug) {
print "N- <$datum><", get_yearMonthDay($removeAllNokEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "N- <$datum><", get_yearMonthDay($removeAllNokEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
applications/archive.pl view on Meta::CPAN
}
}
close(CSV);
my ( $tWeek, $tYear ) = get_week ('yesterday');
print "WF <week$tWeek><$filename>\nW <$path/$weekFilename>\n" if ($debug);
} else {
print "Cannot open $filename!\n";
}
close(CAT);
applications/archive.pl view on Meta::CPAN
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub gzipOrRemoveHttpDumpDebug {
my ($gzipDebugEpoch, $removeDebugEpoch, $debugPath, $debugFilename) = @_;
my ($suffix, $extentie, $datum, $restant);
print "<$debugFilename>\n" if ($debug);
my $_debugFilename = reverse $debugFilename;
my ($_suffix, $_extentie) = reverse split(/\./, $_debugFilename, 2);
$suffix = reverse $_suffix;
$extentie = reverse $_extentie;
($datum, $restant) = split(/\-/, $suffix, 2);
if (defined $restant) {
$datum = substr($datum, 0, 8);
if ( $extentie ) {
if ( $extentie eq 'htm' ) {
if ($datum le get_yearMonthDay($gzipDebugEpoch)) {
if ($debug) {
print "HT+<$datum><".get_yearMonthDay($gzipDebugEpoch)."><$debugPath><$debugFilename>\n";
} else {
print EMAILREPORT "HT+<$datum><".get_yearMonthDay($gzipDebugEpoch)."> gzip <$debugPath><$debugFilename>\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$debugPath.'/'.$debugFilename, $debug);
print EMAILREPORT "HT+ E R R O R: <$stderr>\n" unless ( $status );
}
}
} elsif ( $extentie eq 'htm.gz' ) {
if ($datum le get_yearMonthDay($removeDebugEpoch)) {
if ($debug) {
print "HT-<$datum><".get_yearMonthDay($removeDebugEpoch)."><$debugPath><$debugFilename>\n";
} else {
print EMAILREPORT "HT-<$datum><".get_yearMonthDay($removeDebugEpoch)."> unlink <$debugPath><$debugFilename>\n";
unlink ($debugPath.'/'.$debugFilename);
}
}
}
}
}
applications/archive.pl view on Meta::CPAN
sub removeCgisessFiles {
my ($removeCgisessEpoch) = @_;
my $emailreport = "\nRemove cgisess files:\n---------------------\n";
if ( $debug ) { print "$emailreport"; } else { print EMAILREPORT "$emailreport"; }
my @cgisessPathFilenames = glob("$CGISESSPATH/cgisess_*");
foreach my $cgisessPathFilename (@cgisessPathFilenames) {
my (undef, $cgisessFilename) = split (/^$CGISESSPATH\//, $cgisessPathFilename);
my (undef, $sessionID) = split (/^cgisess_/, $cgisessFilename);
print "Filename : <$cgisessFilename><$sessionID>\n" if ($debug >= 2);
my ($sessionExists, %session) = get_session_param ($sessionID, $CGISESSPATH, $cgisessFilename, $debug);
if ( $sessionExists ) {
if (defined $session{ASNMTAP}) {
if ($session{ASNMTAP} eq 'LEXY') {
print " : <$removeCgisessEpoch><" .$session{_SESSION_CTIME}. ">\n" if ($debug >= 2);
if ($removeCgisessEpoch > $session{_SESSION_CTIME}) {
if ($debug) {
print "CS <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
} else {
print EMAILREPORT "CS unlink <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
my ($status, $stdout, $stderr) = call_system ('rm -f '.$cgisessPathFilename, $debug); # unlink ($cgisessPathFilename);
}
} else {
print "CS-<$cgisessPathFilename><$removeCgisessEpoch><" .$session{_SESSION_CTIME}. ">\n" if ($debug >= 2);
}
} else {
print "CS-<$cgisessPathFilename> ASNMTAP not LEXY>\n" if ($debug >= 2);
}
} else {
if ($removeCgisessEpoch > $session{_SESSION_CTIME}) {
if ($debug) {
print "CS <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
} else {
print EMAILREPORT "CS unlink <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
unlink ($cgisessPathFilename);
}
} else {
print "CS-<$cgisessPathFilename> ASNMTAP not LEXY>\n" if ($debug >= 2);
}
}
}
}
}
applications/archive.pl view on Meta::CPAN
my ($suffix, $prefix, $datum, $plugin, $restant, $extentie);
($suffix, $prefix) = split(/\.pl/, $reportFilename, 2);
($datum, $plugin) = split(/\-/, $suffix, 2) if (defined $suffix);
($restant, $extentie) = split(/\./, $prefix, 2) if (defined $prefix);
if ($debug) {
print "<$reportFilename>";
if ($debug >= 2) {
print " S <$suffix>, P <$prefix>" if (defined $prefix);
print " D <$datum>, P <$plugin>" if (defined $plugin);
print " R <$restant>, E <$extentie>" if (defined $extentie);
}
applications/archive.pl view on Meta::CPAN
if (defined $restant) {
$datum = substr($datum, 0, 8);
if ($extentie eq 'pdf') {
if ($datum le get_yearMonthDay($removeReportsEpoch)) {
if ($debug) {
print "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."><$reportPath><$reportFilename>\n";
} else {
print EMAILREPORT "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."> unlink <$reportPath><$reportFilename>\n";
unlink ($reportPath.'/'.$reportFilename);
}
} elsif ($restant =~ /\-Day_\w+\-id_\d+$/) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."><$reportPath><$reportFilename>\n";
} else {
print EMAILREPORT "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."> unlink <$reportPath><$reportFilename>\n";
unlink ($reportPath.'/'.$reportFilename);
}
applications/archive.pl view on Meta::CPAN
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub errorTrapDBI {
my ($error_message, $debug) = @_;
print EMAILREPORT " DBI Error:\n", $error_message, "\nERROR: $DBI::err ($DBI::errstr)\n";
return 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub print_usage () {
print "Usage: $PROGNAME [-A <archivelist>] [-c F|T] [-r F|T] [-d F|T] [-y <years ago>] [-f F|T] [-D <debug>] [-V version] [-h help]\n";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub print_help () {
applications/archive.pl view on Meta::CPAN
YEARS AGO: c => current year or 1..9 => the number of years ago that the '$SERVERTABLEVENTS'
and '$SERVERTABLCOMMENTS' tables need to be created
-f, --force=F|T
F(alse) : don't force CSV import (default)
T(true) : force CSV import
-D, --debug=F|T|L
F(alse) : screendebugging off (default)
T(true) : normal screendebugging on
L(ong) : long screendebugging on
-V, --version
-h, --help
Send email to $SENDEMAILTO if you have questions regarding
use of this software. To submit patches or suggest improvements, send
ASP
view release on metacpan or search on metacpan
as lists, as Win32::ASP::HTMLEncode() was supposed to.
Thanks to Matt Sergeant for the fix.
=item Version 0.97
Optimized and debugged.
=item Version 0.77
Overloaded warn() and subsequently removed prototypes.
Re-implemented SetCookie and BinaryWrite functions.
=item Version 0.11
Optimized and debugged.
=back
=head1 SEE ALSO
AVLTree
view release on metacpan or search on metacpan
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n
deprecate_commaless_var_list|||
get_context||5.006000|n
get_cvn_flags|5.009005||p
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_mstats|||
get_no_modify|||
get_num|||
incpush_use_sep|||
incpush|||
ingroup|||
init_argv_symbols|||
init_dbargs|||
init_debugger|||
init_global_struct|||
init_i18nl10n||5.006000|
init_i18nl14n||5.006000|
init_ids|||
init_interp|||
rsignal_save|||
rsignal_state||5.004000|
rsignal||5.004000|
run_body|||
run_user_filter|||
runops_debug||5.005000|
runops_standard||5.005000|
rv2cv_op_cv||5.013006|
rvpv_dup|||
rxres_free|||
rxres_restore|||
unreferenced_to_tmp_stack|||
unshare_hek_or_pvn|||
unshare_hek|||
unsharepvn||5.004000|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
AWS-CLIWrapper
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub _run {
my ($self, $opt, $cmd) = @_;
my $ret;
if (exists $opt->{'nofork'} && $opt->{'nofork'}) {
# better for perl debugger
my($ok, $err, $buf, $stdout_buf, $stderr_buf) = IPC::Cmd::run(
command => join(' ', @$cmd),
timeout => $opt->{timeout} || $self->{timeout},
);
$ret->{stdout} = join "", @$stdout_buf;
lib/AWS/CLIWrapper.pm view on Meta::CPAN
timeout => Int
Maximum time the "aws" command is allowed to run before aborting.
default is 30 seconds, unless overridden with AWS_CLIWRAPPER_TIMEOUT environment variable.
nofork => Int (>0)
Call IPC::Cmd::run vs. IPC::Cmd::run_forked (mostly useful if/when in perl debugger). Note: 'timeout', if used with 'nofork', will merely cause an alarm and return. ie. 'run' will NOT kill the awscli command like 'run_forked' will.
croak_on_error => Int (>0)
When set to a truthy value, this will make AWS::CLIWrapper to croak() with error message when `aws` command exits with non-zero status. Default behavior is to set $AWS::CLIWrapper::Error and return.
catch_error_pattern => RegExp
AWS-Lambda-Quick
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
=item Manage an integration and integration response for that resource
=back
And then debug all the above things, a lot, and google weird error
messages it generates when you inevitably make a mistake.
This module provides a way to do all of this completely transparently
just by executing your script, without having to either interact with
the AWS Management Console nor directly use the awscli utility.
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
In the interest of being as quick as possible, when this is environment
variable is enabled the URL for the upload is not computed and printed
out.
=head2 Enabling debugging output
To gain a little more insight into what is going on you can set
the C<AWS_LAMBDA_QUICK_DEBUG> environment variable to enabled
debugging to STDERR:
shell$ AWS_LAMBDA_QUICK_DEBUG=1 perl lambda-function.pl
updating function code
function code updated
updating function configuration
( run in 1.282 second using v1.01-cache-2.11-cpan-49f99fa48dc )