Result:
found more than 436 distributions - search limited to the first 2001 files matching your query
( run in 0.648 )
ASNMTAP
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
GetOptions (
"A:s" => \$opt_A, "archivelist:s" => \$opt_A,
"c:s" => \$opt_c, "cgisess:s" => \$opt_c,
"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,
applications/archive.pl view on Meta::CPAN
if ($opt_d) {
if ($opt_d eq 'F' || $opt_d eq 'T') {
$doDatabase = ($opt_d eq 'F') ? 0 : 1;
} else {
usage("Invalid database: $opt_d\n");
}
}
if ($opt_y) {
if ($opt_y eq 'c') {
applications/archive.pl view on Meta::CPAN
# 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);
applications/archive.pl view on Meta::CPAN
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";
applications/archive.pl view on Meta::CPAN
$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
# 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');
applications/archive.pl view on Meta::CPAN
}
} 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);
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
applications/archive.pl view on Meta::CPAN
} 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);
applications/archive.pl view on Meta::CPAN
# 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);
applications/archive.pl view on Meta::CPAN
F(alse) : don't remove the cgisess files
T(true) : remove the cgisess files (default)
-r, --reports=F|T
F(alse) : don't backup Csv, Sql, Error, Week, Debug reports
T(true) : remove backup Csv, Sql, Error, Week, Debug reports (default)
-d, --database=F|T
F(alse) : don't archive the '$SERVERTABLEVENTS' and '$SERVERTABLCOMMENTS' tables (default)
T(true) : archive the '$SERVERTABLEVENTS' and '$SERVERTABLCOMMENTS' tables
-y, --yearsago=<years ago>
YEARS AGO: c => current year or 1..9 => the number of years ago that the '$SERVERTABLEVENTS'
and '$SERVERTABLCOMMENTS' tables need to be created
ASP
view release on metacpan or search on metacpan
}
=head2 AddDeathHook LIST
Allows cleanup code to be executed when you C<die> or C<exit>.
Useful for closing database connections in the event of a
fatal error.
<%
my $conn = Win32::OLE-new('ADODB.Connection');
$conn->Open("MyDSN");
ASP4-PSGI
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4x-Captcha-Imager
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4x-Linker
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4x-Router
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
AUBBC
view release on metacpan or search on metacpan
The [c] or code tags can highlight Perl code, highlighting the Perl code with CSS in HTML/XHTML,
and in the examples folder the tag_list.cgi file has a CSS code you could work from and now a setting to change to a costume highlighter function.
This module addresses many security issues the BBcode tags may have mainly cross site script also known as XSS.
Each message is escaped before it gets returned if script_escape is Enabled and checked for many types of security problems before that tag converts to HTML/XHTML.
The script_escape setting and method also converts the ' sign so the text can be stored in a SQL back-end.
Most of the free web portals use the | sign as the delimiter for the flat file database, the script_escape setting and method also converts that sign so the structure of the database is retained.
Allows easy conversion to HTML and XHTML, existing tags will convert to the HTML type set.
If there isn't a popular tag available this module provides a method to "Build your own tags" custom tags can help link to parts of the current web page, other web pages and add other HTML elements.
AVLTree
view release on metacpan or search on metacpan
lib/AVLTree.pm view on Meta::CPAN
printf "Size of tree is now: %d\n", $tree->size();
...
# Suppose you want the tree to hold generic data items, e.g. hashrefs
# which hold some data. We can deal with these by definying a custom
# comparison function based on one of the attributes of these data items,
# e.g. 'id':
sub compare {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
lib/AVLTree.pm view on Meta::CPAN
}
# Now can do the same as with numbers
my $tree = AVLTree->new(\&compare);
my $insert_ok = $tree->insert({ id => 10, data => 'ten' });
croak "Could not insert item" unless $insert_ok;
$insert_ok = $tree->insert({ id => 20, data => 'twenty' });
...
my $id = 10;
my $result = $tree->find({ id => $id });
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else {
print "Item with id $id not found\n";
}
# forward tree traversal
lib/AVLTree.pm view on Meta::CPAN
=head2 C<find>
Arg [1] : Item to search, can be defined just in terms of the attribute
with which the items in the tree are compared.
Example : $tree->find({ id => 10 }); # objects in the tree can hold data as well
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else { print "Item with id $id not found\n"; }
Description : Query if an item exists in the tree.
Returntype : The item, if found, as stored in the tree or undef
lib/AVLTree.pm view on Meta::CPAN
=head2 C<insert>
Arg [1] : An item to insert in the tree.
Example : my $ok = $tree->insert({ id => 10, data => 'ten' });
croak "Unable to insert 10" unless $ok;
Description : Insert an item in the tree, use the provided, upon tree construction,
comparison function to determine the position of the item in the tree
AWS-CLI-Config
view release on metacpan or search on metacpan
lib/AWS/CLI/Config.pm view on Meta::CPAN
use strict;
use warnings;
sub new {
my $class = shift;
my $data = @_ ? @_ > 1 ? { @_ } : shift : {};
return bless $data, $class;
}
sub AUTOLOAD {
our $AUTOLOAD;
my $self = shift;
AWS-CLIWrapper
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub amplifyuibuilder { shift->_execute('amplifyuibuilder', @_) }
sub apigateway { shift->_execute('apigateway', @_) }
sub apigatewaymanagementapi { shift->_execute('apigatewaymanagementapi', @_) }
sub apigatewayv2 { shift->_execute('apigatewayv2', @_) }
sub appconfig { shift->_execute('appconfig', @_) }
sub appconfigdata { shift->_execute('appconfigdata', @_) }
sub appfabric { shift->_execute('appfabric', @_) }
sub appflow { shift->_execute('appflow', @_) }
sub appintegrations { shift->_execute('appintegrations', @_) }
sub application_autoscaling { shift->_execute('application-autoscaling', @_) }
sub application_insights { shift->_execute('application-insights', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub cloudhsm { shift->_execute('cloudhsm', @_) }
sub cloudhsmv2 { shift->_execute('cloudhsmv2', @_) }
sub cloudsearch { shift->_execute('cloudsearch', @_) }
sub cloudsearchdomain { shift->_execute('cloudsearchdomain', @_) }
sub cloudtrail { shift->_execute('cloudtrail', @_) }
sub cloudtrail_data { shift->_execute('cloudtrail-data', @_) }
sub cloudwatch { shift->_execute('cloudwatch', @_) }
sub codeartifact { shift->_execute('codeartifact', @_) }
sub codebuild { shift->_execute('codebuild', @_) }
sub codecatalyst { shift->_execute('codecatalyst', @_) }
sub codecommit { shift->_execute('codecommit', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub connectcases { shift->_execute('connectcases', @_) }
sub connectparticipant { shift->_execute('connectparticipant', @_) }
sub controltower { shift->_execute('controltower', @_) }
sub cur { shift->_execute('cur', @_) }
sub customer_profiles { shift->_execute('customer-profiles', @_) }
sub databrew { shift->_execute('databrew', @_) }
sub dataexchange { shift->_execute('dataexchange', @_) }
sub datapipeline { shift->_execute('datapipeline', @_) }
sub datasync { shift->_execute('datasync', @_) }
sub dax { shift->_execute('dax', @_) }
sub deploy { shift->_execute('deploy', @_) }
sub detective { shift->_execute('detective', @_) }
sub devicefarm { shift->_execute('devicefarm', @_) }
sub devops_guru { shift->_execute('devops-guru', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub emr_serverless { shift->_execute('emr-serverless', @_) }
sub es { shift->_execute('es', @_) }
sub events { shift->_execute('events', @_) }
sub evidently { shift->_execute('evidently', @_) }
sub finspace { shift->_execute('finspace', @_) }
sub finspace_data { shift->_execute('finspace-data', @_) }
sub firehose { shift->_execute('firehose', @_) }
sub fis { shift->_execute('fis', @_) }
sub fms { shift->_execute('fms', @_) }
sub forecast { shift->_execute('forecast', @_) }
sub forecastquery { shift->_execute('forecastquery', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub importexport { shift->_execute('importexport', @_) }
sub inspector { shift->_execute('inspector', @_) }
sub inspector2 { shift->_execute('inspector2', @_) }
sub internetmonitor { shift->_execute('internetmonitor', @_) }
sub iot { shift->_execute('iot', @_) }
sub iot_data { shift->_execute('iot-data', @_) }
sub iot_jobs_data { shift->_execute('iot-jobs-data', @_) }
sub iot_roborunner { shift->_execute('iot-roborunner', @_) }
sub iot1click_devices { shift->_execute('iot1click-devices', @_) }
sub iot1click_projects { shift->_execute('iot1click-projects', @_) }
sub iotanalytics { shift->_execute('iotanalytics', @_) }
sub iotdeviceadvisor { shift->_execute('iotdeviceadvisor', @_) }
sub iotevents { shift->_execute('iotevents', @_) }
sub iotevents_data { shift->_execute('iotevents-data', @_) }
sub iotfleethub { shift->_execute('iotfleethub', @_) }
sub iotfleetwise { shift->_execute('iotfleetwise', @_) }
sub iotsecuretunneling { shift->_execute('iotsecuretunneling', @_) }
sub iotsitewise { shift->_execute('iotsitewise', @_) }
sub iotthingsgraph { shift->_execute('iotthingsgraph', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub medialive { shift->_execute('medialive', @_) }
sub mediapackage { shift->_execute('mediapackage', @_) }
sub mediapackage_vod { shift->_execute('mediapackage-vod', @_) }
sub mediapackagev2 { shift->_execute('mediapackagev2', @_) }
sub mediastore { shift->_execute('mediastore', @_) }
sub mediastore_data { shift->_execute('mediastore-data', @_) }
sub mediatailor { shift->_execute('mediatailor', @_) }
sub memorydb { shift->_execute('memorydb', @_) }
sub meteringmarketplace { shift->_execute('meteringmarketplace', @_) }
sub mgh { shift->_execute('mgh', @_) }
sub mgn { shift->_execute('mgn', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub organizations { shift->_execute('organizations', @_) }
sub osis { shift->_execute('osis', @_) }
sub outposts { shift->_execute('outposts', @_) }
sub panorama { shift->_execute('panorama', @_) }
sub payment_cryptography { shift->_execute('payment-cryptography', @_) }
sub payment_cryptography_data { shift->_execute('payment-cryptography-data', @_) }
sub personalize { shift->_execute('personalize', @_) }
sub personalize_events { shift->_execute('personalize-events', @_) }
sub personalize_runtime { shift->_execute('personalize-runtime', @_) }
sub pi { shift->_execute('pi', @_) }
sub pinpoint { shift->_execute('pinpoint', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub qldb_session { shift->_execute('qldb-session', @_) }
sub quicksight { shift->_execute('quicksight', @_) }
sub ram { shift->_execute('ram', @_) }
sub rbin { shift->_execute('rbin', @_) }
sub rds { shift->_execute('rds', @_) }
sub rds_data { shift->_execute('rds-data', @_) }
sub redshift { shift->_execute('redshift', @_) }
sub redshift_data { shift->_execute('redshift-data', @_) }
sub redshift_serverless { shift->_execute('redshift-serverless', @_) }
sub rekognition { shift->_execute('rekognition', @_) }
sub resiliencehub { shift->_execute('resiliencehub', @_) }
sub resource_explorer_2 { shift->_execute('resource-explorer-2', @_) }
sub resource_groups { shift->_execute('resource-groups', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<apigatewayv2>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appconfig>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appconfigdata>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appfabric>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appflow>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<cloudsearchdomain>($operation:Str, $param:HashRef, %opt:Hash)
=item B<cloudtrail>($operation:Str, $param:HashRef, %opt:Hash)
=item B<cloudtrail_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<cloudwatch>($operation:Str, $param:HashRef, %opt:Hash)
=item B<codeartifact>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<cur>($operation:Str, $param:HashRef, %opt:Hash)
=item B<customer_profiles>($operation:Str, $param:HashRef, %opt:Hash)
=item B<databrew>($operation:Str, $param:HashRef, %opt:Hash)
=item B<dataexchange>($operation:Str, $param:HashRef, %opt:Hash)
=item B<datapipeline>($operation:Str, $param:HashRef, %opt:Hash)
=item B<datasync>($operation:Str, $param:HashRef, %opt:Hash)
=item B<dax>($operation:Str, $param:HashRef, %opt:Hash)
=item B<deploy>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<evidently>($operation:Str, $param:HashRef, %opt:Hash)
=item B<finspace>($operation:Str, $param:HashRef, %opt:Hash)
=item B<finspace_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<firehose>($operation:Str, $param:HashRef, %opt:Hash)
=item B<fis>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<internetmonitor>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot_jobs_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot_roborunner>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot1click_devices>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<iotdeviceadvisor>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotevents>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotevents_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotfleethub>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotfleetwise>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<mediapackagev2>($operation:Str, $param:HashRef, %opt:Hash)
=item B<mediastore>($operation:Str, $param:HashRef, %opt:Hash)
=item B<mediastore_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<mediatailor>($operation:Str, $param:HashRef, %opt:Hash)
=item B<memorydb>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<panorama>($operation:Str, $param:HashRef, %opt:Hash)
=item B<payment_cryptography>($operation:Str, $param:HashRef, %opt:Hash)
=item B<payment_cryptography_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<personalize>($operation:Str, $param:HashRef, %opt:Hash)
=item B<personalize_events>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<rbin>($operation:Str, $param:HashRef, %opt:Hash)
=item B<rds>($operation:Str, $param:HashRef, %opt:Hash)
=item B<rds_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<redshift>($operation:Str, $param:HashRef, %opt:Hash)
=item B<redshift_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<redshift_serverless>($operation:Str, $param:HashRef, %opt:Hash)
=item B<rekognition>($operation:Str, $param:HashRef, %opt:Hash)
AWS-CloudFront
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
AWS-IP
view release on metacpan or search on metacpan
lib/AWS/IP.pm view on Meta::CPAN
use AWS::IP;
my $aws = AWS::IP->new(600, '/tmp/aws_ip_cache');
# get the raw data as a Perl reference
my $aws_ip_data = $aws->get_raw_data;
# check if an ip address is AWS
if ($aws->is_aws_ip('50.0.0.1')
{
..
lib/AWS/IP.pm view on Meta::CPAN
{
...
}
# time passes, cache has expired
$aws_ip_data = $aws->get_raw_data; # auto refreshes
=head2 DESCRIPTION
AWS L<publish|https://ip-ranges.amazonaws.com/ip-ranges.json> their IP ranges, which periodically change. This module downloads and serializes the IP ranges into a Perl data hash reference. It caches the data, and if the cache expires, re-downloads a...
=head2 new ($cache_timeout_secs, [$cache_path])
Creates a new AWS::IP object and sets up the cache. Requires an number for the cache timeout seconds. Optionally takes a cache path argument. If no cache path is supplied, AWS::IP will use a random temp directory. If you want to reuse the cache over ...
lib/AWS/IP.pm view on Meta::CPAN
my $ip_ranges;
if ($service)
{
$ip_ranges = Net::CIDR::Set->new( map { $_->{ip_prefix} } grep { $_->{service} eq $service } @{$self->get_raw_data->{prefixes}});
}
else
{
$ip_ranges = Net::CIDR::Set->new( map { $_->{ip_prefix} } @{$self->get_raw_data->{prefixes}} );
}
$ip_ranges->contains($ip);
}
=head2 get_raw_data
Returns the entire raw IP dataset as a Perl data structure.
=cut
sub get_raw_data
{
my ($self) = @_;
my $entry = $self->{cache}->entry(CACHE_KEY);
lib/AWS/IP.pm view on Meta::CPAN
}
}
=head2 get_cidrs
Returns an arrayref of the L<CIDRs|http://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing> in the AWS IP address data.
=cut
sub get_cidrs
{
my ($self) = @_;
[ map { $_->{ip_prefix} } @{$self->get_raw_data->{prefixes}} ];
}
=head2 get_cidrs_by_region ($region)
Returns an arrayref of CIDRs matching the provided region.
lib/AWS/IP.pm view on Meta::CPAN
sub get_cidrs_by_region
{
my ($self, $region) = @_;
croak 'Error must provide region' unless $region;
[ map { $_->{ip_prefix} } grep { $_->{region} eq $region } @{$self->get_raw_data->{prefixes}} ];
}
=head2 get_cidrs_by_service ($service)
Returns an arrayref of CIDRs matching the provided service (AMAZON|EC2|CLOUDFRONT|ROUTE53|ROUTE53_HEALTHCHECKS).
lib/AWS/IP.pm view on Meta::CPAN
sub get_cidrs_by_service
{
my ($self, $service) = @_;
croak 'Error must provide service' unless $service;
[ map { $_->{ip_prefix} } grep { $_->{service} eq $service } @{$self->get_raw_data->{prefixes}} ];
}
=head2 get_regions
Returns an arrayref of the regions in the AWS IP address data.
=cut
sub get_regions
{
my ($self) = @_;
my %regions;
for (@{$self->get_raw_data->{prefixes}})
{
$regions{ $_->{region} } = 1;
}
[ keys %regions ];
}
=head2 get_services
Returns an arrayref of the services (Amazon, EC2 etc) in the AWS IP address data.
=cut
sub get_services
{
my ($self) = @_;
my %services;
for (@{$self->get_raw_data->{prefixes}})
{
$services{ $_->{service} } = 1;
}
[ keys %services ];
}
lib/AWS/IP.pm view on Meta::CPAN
if ($response->{success})
{
my $entry = $self->{cache}->entry(CACHE_KEY);
$entry->set($response->{content});
# return the data
$response->{content};
}
else
{
croak "Error requesting $response->{url} $response->{code} $response->{reason}";
}
}
sub _refresh_cache_from_string
{
my ($self, $data) = @_;
my $entry = $self->{cache}->entry(CACHE_KEY);
$entry->set($data);
# return the data
$data;
}
1;
AWS-Lambda-Quick
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
use AWS::Lambda::Quick (
name => 'hello-world',
);
sub handler {
my $data = shift;
my $name = $data->{queryStringParameters}{who} // "World";
return {
statusCode => 200,
headers => {
'Content-Type' => 'text/plain',
},
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
This module allows you to very quickly create a Perl based AWS
Lambda function which can be accessed via HTTP.
Coding Lambda functions in Perl is straight forward: You need only
implement a script with the one C<handler> function that returns the
expected data structure as described in the L<AWS::Lambda>
documentation.
The hard part is configuring AWS to execute the code. Traditionally
you have to complete the following steps.
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
use AWS::Lambda::Quick (
name => 'echo',
);
sub handler {
my $data = shift;
return {
statusCode => 200,
headers => {
'Content-Type' => 'application/json',
},
body => encode_json($data),
};
}
1;
=head3 Create a new integration-response and method-response
The integration response and method response are analogous to the
integration and method - but instead of getting data from HTTP to
Lambda, they get Lambda data back to HTTP.
Because we want our handler to have complete control over the output
we don't do anything special with what we create.
=head3 Deploying the Code.
AWS-Lambda
view release on metacpan or search on metacpan
author/pod-stripper/scripts/pod_stripper.pl view on Meta::CPAN
open my $pm, '<', $file;
$module = <$pm>;
close $pm
}
# it is not pod, but might be some data.
# skip it for safety.
if ($module =~ /^__DATA__$/m) {
return
}
AWS-Networks
view release on metacpan or search on metacpan
lib/AWS/Networks.pm view on Meta::CPAN
=head1 DESCRIPTION
This module parses the official public IP network information published by Amazon Web Services at https://ip-ranges.amazonaws.com/ip-ranges.json
Please read and understand the information can be found at http://docs.aws.amazon.com/general/latest/gr/aws-ip-ranges.html to make sense of the data retured by this module.
=head1 USAGE
Instance an object, and use it to filter information of interest to you with the attributes and methods provided.
lib/AWS/Networks.pm view on Meta::CPAN
Standard Moose constructor. Can specify a custom URL to download a document that follows the same schema
=head2 url
Returns the URL from which the information was retrieved. Returns undef on filtered datasets
=head2 sync_token
Returns a DateTime object created from the current timestamp of the syncToken reported from the service
lib/AWS/Networks.pm view on Meta::CPAN
region can be one of: ap-northeast-1 | ap-southeast-1 | ap-southeast-2 | cn-north-1 | eu-central-1 | eu-west-1 | sa-east-1 | us-east-1 | us-gov-west-1 | us-west-1 | us-west-2 | GLOBAL, but expect new values to appear
=head2 services
Returns an ArrayRef of the different services present in the current dataset
=head2 regions
Returns an ArrayRef of the different regions present in the current dataset
=head2 cidrs
Returns an ArrayRef with the CIDR blocks in the dataset
=head2 by_region($region)
Returns a new AWS::Networks object with the data filtered to only the objects in the
specified region
=head2 by_service($service)
Returns a new AWS::Networks object with the data filtered to only the services specified
=cut
=head1 CONTRIBUTE
AWS-S3
view release on metacpan or search on metacpan
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
sub new {
my ($class, %args) = @_;
my $s = bless {
data => [ ],
page_number => 0,
idx => 0,
%args,
}, $class;
$s->_init;
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
} # end foreach()
$s->{page_number}--;
$s->{marker} = '' unless defined( $s->{marker} );
$s->{__fetched_first_page} = 0;
$s->{data} = [];
$s->{pattern} ||= qr(.*);
} # end _init()
sub marker { shift->{marker} }
sub pattern { shift->{pattern} }
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
sub has_next { shift->{has_next} }
sub next {
my $s = shift;
if( exists( $s->{data}->[ $s->{idx} ] ) ) {
return $s->{data}->[ $s->{idx}++ ];
} else {
# End of the current resultset, see if we can get another page of records:
if( my $page = $s->next_page ) {
$s->{data} = $page;
$s->{idx} = 0;
return $s->{data}->[ $s->{idx}++ ];
} else {
# No more pages, no more data:
return;
}
}
}
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
} # end next_page()
sub _next {
my $s = shift;
if ( my $item = shift( @{ $s->{data} } ) ) {
return $item;
} else {
if ( my @chunk = $s->_fetch() ) {
push @{ $s->{data} }, @chunk;
return shift( @{ $s->{data} } );
} else {
return;
} # end if()
} # end if()
} # end _next()
AWS-SQS-Simple
view release on metacpan or search on metacpan
lib/AWS/SQS/Simple.pm view on Meta::CPAN
END_POINT => $parameter_hash{ END_POINT } ,
};
## Private and class data here.
bless( $self, $class );
return $self;
lib/AWS/SQS/Simple.pm view on Meta::CPAN
my $self = shift ;
my $url_to_access = shift ;
my $contents ;
my $attempts = 0 ;
my $got_data = 0 ;
my $this_profile_location ;
my $response;
until( $got_data or $attempts > 5 ) {
my $request = HTTP::Request->new(
GET => $url_to_access
);
lib/AWS/SQS/Simple.pm view on Meta::CPAN
$response = $ua->request( $request ) ;
if( $response->is_success() ) {
$contents = $response->content;
$got_data = 1;
} else {
$contents = $response->content ;
AWS-Signature-V2
view release on metacpan or search on metacpan
cpanfile.snapshot view on Meta::CPAN
URI::_punycode 0.04
URI::_query undef
URI::_segment undef
URI::_server undef
URI::_userpass undef
URI::data undef
URI::file 4.21
URI::file::Base undef
URI::file::FAT undef
URI::file::Mac undef
URI::file::OS2 undef
AWS-XRay
view release on metacpan or search on metacpan
lib/AWS/XRay.pm view on Meta::CPAN
my @args = @_;
capture(
$package,
sub {
my $segment = shift;
$segment->{metadata}->{method} = $method;
$segment->{metadata}->{package} = $package;
$orig->(@args);
},
);
};
}
lib/AWS/XRay.pm view on Meta::CPAN
=head1 DESCRIPTION
AWS::XRay is a tracing library with AWS X-Ray.
AWS::XRay sends segment data to L<AWS X-Ray Daemon|https://docs.aws.amazon.com/xray/latest/devguide/xray-daemon.html>.
=head1 FUNCTIONS
=head2 new_trace_id
Generate a Trace ID. (e.g. "1-581cf771-a006649127e371903a2de979")
L<Document|https://docs.aws.amazon.com/xray/latest/devguide/xray-api-sendingdata.html#xray-api-traceids>
=head2 capture($name, $code)
capture() executes $code->($segment) and send the segment document to X-Ray daemon.
lib/AWS/XRay.pm view on Meta::CPAN
add_capture() adds a capture to package::method.
AWS::XRay->add_capture("MyApp::Model", "foo", "bar");
The segments of these captures are named as "MyApp::Model".
These segments include metadata "method": "foo" or "bar".
=head1 CONFIGURATION
=head2 sampling_rate($rate)
lib/AWS/XRay.pm view on Meta::CPAN
=head2 auto_flush($mode)
Set/Get auto flush mode.
When $mode is 1 (default), segment data will be sent to xray daemon immediately after capture() called.
When $mode is 0, segment data are buffered in memory. You should call AWS::XRay->sock->flush() to send the buffered segment data or call AWS::XRay->sock->close() to discard the buffer.
=head2 AWS_XRAY_DAEMON_ADDRESS environment variable
Set the host and port of the X-Ray daemon. Default 127.0.0.1:2000
AXL-Client-Simple
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
Aard
view release on metacpan or search on metacpan
lib/Aard.pm view on Meta::CPAN
printf "The tenth entry's key: %s\n", $dict->key(9);
printf "The tenth entry's value: %s\n", $dict->article(9);
=head1 DESCRIPTION
Aard is a module for reading files in the Aard Dictionary format (.aar). A dictionary is an array of I<(key, article)> pairs, with some associated metadata.
=over
=item B<new>(I<filename>)
lib/Aard.pm view on Meta::CPAN
Returns the total number of volumes for this dictionary.
=item B<meta>
Returns the raw metadata as a hashref.
=item B<article_count>
Returns the number of unique articles in this volume (if B<article_count_is_volume_total> is true) or in this dictionary (otherwise).
lib/Aard.pm view on Meta::CPAN
Returns the full license text
=item B<source>
Returns the dictionary data source
=back
=head1 SEE ALSO
Abilities
view release on metacpan or search on metacpan
lib/Abilities.pm view on Meta::CPAN
attributes to return objects. While this made it easier to calculate
abilities, it made this system a bit less flexible.
In version 0.3, C<Abilities> changed the requirement such that both these
attributes need to return strings (the names of the roles/actions). If your implementation
has granted roles and actions stored in a database by names, this made life a bit easier
for you. On other implementations, however, this has the potential of
requiring you to write a bit more code. If that is the case, I apologize,
but keep in mind that you can still store granted roles and actions
any way you want in a database (either by names or by references), just
as long as you correctly provide C<roles> and C<actions>.
Unfortunately, in both versions 0.3 and 0.4, I made a bit of a mess
that rendered both versions unusable. While I documented the C<roles>
attribute as requiring role names instead of role objects, the actual
implementation still required role objects. This has now been fixed,
but it also meant I had to add a new requirement: consuming classes
now have to provide a method called C<get_role()> that takes the name
of a role and returns its object. This will probably means loading the
role from a database and blessing it into your role class that also consumes
this module.
I apologize for any inconvenience this might have caused.
=head1 AUTHOR
Abstract-Meta-Class
view release on metacpan or search on metacpan
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
has '$.attr1' => (default => 0);
=head1 DESCRIPTION
An object that describes an attribute.
It includes required, data type, association validation, default value, lazy retrieval.
Name of attribute must begin with one of the follwoing prefix:
$. => Scalar,
@. => Array,
%. => Hash,
&. => Code,
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
my ($type, $accessor_name) = ($name =~ /^([\$\@\%\&])\.(.*)$/);
confess "invalid attribute defintion ${class}::" .($accessor_name || $name) .", supported prefixes are \$.,%.,\@.,&."
if ! $type || ! $supported_type{$type};
my %options;
$args{data_type_validation} = 1
if (! exists($args{data_type_validation})
&& ($type eq '@' || $type eq '%' || $args{associated_class}));
$options{'&.' . $_ } = $args{$_}
for grep {exists $args{$_}} (qw(on_read on_change on_validate));
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
$options{'$.storage_key'} = $storage_key;
$options{'$.mutator'} = "set_$accessor_name";
$options{'$.accessor'} = $accessor_name;
$options{'$.' . $_ } = $args{$_}
for grep {exists $args{$_}}
(qw(class required default item_accessor associated_class data_type_validation index_by the_other_end transistent storage_type));
$options{'$.perl_type'} = $supported_type{$type};
unless ($args{default}) {
if($type eq '%') {
$options{'$.default'} = sub{ {} };
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
=cut
sub the_other_end { shift()->{'$.the_other_end'} }
=item data_type_validation
Flag that turn on/off data type validation.
Data type validation happens when using association_class or Array or Hash data type
unless you explicitly disable it by seting data_type_validation => 0.
=cut
sub data_type_validation { shift()->{'$.data_type_validation'} }
=item on_read
Returns code reference that will be replace data read routine
has '%.attrs.' => (
item_accessor => 'attr'
on_read => sub {
my ($self, $attribute, $scope, $key) = @_;
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
sub on_read { shift()->{'&.on_read'} }
=item set_on_read
Sets code reference that will be replace data read routine
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_read(sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
}
=item on_change
Code reference that will be executed when data is set,
Takes reference to the variable to be set.
=cut
sub on_change { shift()->{'&.on_change'} }
=item set_on_change
Sets code reference that will be executed when data is set,
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_change(sub {
my ($self, $attribute, $scope, $value, $key) = @_;
if($scope eq 'mutator') {
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
=item on_validate
Returns on validate code reference.
It is executed before the data type validation happens.
=cut
sub on_validate { shift()->{'&.on_validate'} }
=item set_on_validate
Sets code reference that will be replace data read routine
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_read(sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
Ac_me-Local
view release on metacpan or search on metacpan
README
t/00-load.t
t/manifest.t
t/pod-coverage.t
t/pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
AcePerl
view release on metacpan or search on metacpan
require Ace::Iterator;
require Ace::Object;
eval qq{use Ace::Freesubs}; # XS file, may not be available
# Map database names to objects (to fix file-caching issue)
my %NAME2DB;
# internal cache of objects
my %MEMORY_CACHE;
# *models = \&classes;
sub connect {
my $class = shift;
my ($host,$port,$user,$pass,$path,$program,
$objclass,$timeout,$query_timeout,$database,
$server_type,$url,$u,$p,$cache,$other);
# one-argument single "URL" form
if (@_ == 1) {
return $class->connect(-url=>shift);
($host,$port,$u,$pass,$p,$server_type) = $class->process_url($url)
or croak "Usage: Ace->connect(-host=>\$host,-port=>\$port [,-path=>\$path]\n"
if defined $url;
if ($path) { # local database
$server_type = 'Ace::Local';
} else { # either RPC or socket server
$host ||= 'localhost';
$user ||= $u || '';
$path ||= $p || '';
}
# we've normalized parameters, so do the actual connect
eval "require $server_type" || croak "Module $server_type not loaded: $@";
if ($path) {
$database = $server_type->connect(-path=>$path,%$other);
} else {
$database = $server_type->connect($host,$port,$query_timeout,$user,$pass,%$other);
}
unless ($database) {
$Ace::Error ||= "Couldn't open database";
return;
}
my $contents = {
'database'=> $database,
'host' => $host,
'port' => $port,
'path' => $path,
'class' => $objclass || 'Ace::Object',
'timeout' => $query_timeout,
}
sub reopen {
my $self = shift;
return 1 if $self->ping;
my $class = ref($self->{database});
my $database;
if ($self->{path}) {
$database = $class->connect(-path=>$self->{path},%{$self->other});
} else {
$database = $class->connect($self->{host},$self->{port}, $self->{timeout},
$self->{user},$self->{pass},%{$self->{other}});
}
unless ($database) {
$Ace::Error = "Couldn't open database";
return;
}
$self->{database} = $database;
1;
}
sub class {
my $self = shift;
($user,$host,$port) = ($1,$2,$3);
$server_type = 'Ace::SocketServer';
} elsif (m!^sace://([^:]+):(\d+)$!) { # sace://localhost:2005
($host,$port) = ($1,$2);
$server_type = 'Ace::SocketServer';
} elsif (m!^tace:(/.+)$!) { # tace:/path/to/database
$path = $1;
$server_type = 'Ace::Local';
} elsif (m!^(/.+)$!) { # /path/to/database
$path = $1;
$server_type = 'Ace::Local';
} else {
return;
}
}
# Return the low-level Ace::AceDB object
sub db {
return $_[0]->{'database'};
}
# Fetch a model from the database.
# Since there are limited numbers of models, we cache
# the results internally.
sub model {
my $self = shift;
require Ace::Model;
}
#### END: CACHE AND CARRY CODE ####
# Fetch one or a group of objects from the database
sub fetch {
my $self = shift;
my ($class,$pattern,$count,$offset,$query,$filled,$total,$filltag) =
rearrange(['CLASS',['NAME','PATTERN'],'COUNT','OFFSET','QUERY',
['FILL','FILLED'],'TOTAL','FILLTAG'],@_);
sub show {
my ($self,$class,$pattern,$tag) = @_;
$Ace::Error = '';
return unless $self->count($class,$pattern);
# if we get here, then we've got some data to return.
my @result;
my $ts = $self->{'timestamps'} ? '-T' : '';
$self->{database}->query("show -j $ts $tag");
my $result = $self->read_object;
unless ($result =~ /(\d+) object dumped/m) {
$Ace::Error = 'Unexpected close during show';
return;
}
return grep (!m!^//!,split("\n\n",$result));
}
sub read_object {
my $self = shift;
return unless $self->{database};
my $result;
while ($self->{database}->status == STATUS_PENDING()) {
my $data = $self->{database}->read();
# $data =~ s/\0//g; # get rid of nulls in the buffer
$result .= $data if defined $data;
}
return $result;
}
# do a query, and return the result immediately
sub raw_query {
my ($self,$query,$no_alert,$parse) = @_;
$self->_alert_iterators unless $no_alert;
$self->{database}->query($query, $parse ? ACE_PARSE : () );
return $self->read_object;
}
# return the last error
sub error {
$Ace::Error = shift() if defined($_[0]);
$Ace::Error=~s/\0//g; # get rid of nulls
return $Ace::Error;
}
# close the database
sub close {
my $self = shift;
$self->raw_query('save') if $self->auto_save;
foreach (keys %{$self->{iterators}}) {
$self->_unregister_iterator($_);
}
delete $self->{database};
}
sub DESTROY {
my $self = shift;
return if caller() =~ /^Cache\:\:/;
# do a query, but don't return the result
sub _query {
my ($self,@query) = @_;
$self->_alert_iterators;
$self->{'database'}->query("@query");
}
# return a portion of the active list
sub _list {
my $self = shift;
$tag = '' unless defined $tag;
my $query = "show -j $tag";
$query .= ' -T' if $self->{timestamps};
$query .= " -b $start" if defined $start;
$query .= " -c $count" if defined $count;
$self->{database}->query($query);
while (my @objects = $self->_fetch_chunk) {
push (@result,@objects);
}
# copy tag into a portion of the tree
if ($tag) {
return wantarray ? @result : $result[0];
}
sub _fetch_chunk {
my $self = shift;
return unless $self->{database}->status == STATUS_PENDING();
my $result = $self->{database}->read();
$result =~ s/\0//g; # get rid of &$#&@!! nulls
my @chunks = split("\n\n",$result);
my @result;
foreach (@chunks) {
next if m!^//!;
Ace - Object-Oriented Access to ACEDB Databases
=head1 SYNOPSIS
use Ace;
# open a remote database connection
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100);
# open a local database connection
$local = Ace->connect(-path=>'~acedb/my_ace');
# simple queries
$sequence = $db->fetch(Sequence => 'D12345');
$count = $db->count(Sequence => 'D*');
$ready = $db->fetch_many(-query=>$query);
while ($obj = $ready->next) {
# do something with obj
}
# database cut and paste
$sequence = $db->fetch(Sequence => 'D12345');
$local_db->put($sequence);
@sequences = $db->fetch(Sequence => 'D*');
$local_db->put(@sequences);
print Ace->error;
print $db->error;
=head1 DESCRIPTION
AcePerl provides an interface to the ACEDB object-oriented database.
Both read and write access is provided, and ACE objects are returned
as similarly-structured Perl objects. Multiple databases can be
opened simultaneously.
You will interact with several Perl classes: I<Ace>, I<Ace::Object>,
I<Ace::Iterator>, I<Ace::Model>. I<Ace> is the database accessor, and
can be used to open both remote Ace databases (running aceserver or
gifaceserver), and local ones.
I<Ace::Object> is the superclass for all objects returned from the
database. I<Ace> and I<Ace::Object> are linked: if you retrieve an
Ace::Object from a particular database, it will store a reference to
the database and use it to fetch any subobjects contained within it.
You may make changes to the I<Ace::Object> and have those changes
written into the database. You may also create I<Ace::Object>s from
scratch and store them in the database.
I<Ace::Iterator> is a utility class that acts as a database cursor for
long-running ACEDB queries. I<Ace::Model> provides object-oriented
access to ACEDB's schema.
Internally, I<Ace> uses the I<Ace::Local> class for access to local
databases and I<Ace::AceDB> for access to remote databases.
Ordinarily you will not need to interact directly with either of these
classes.
=head1 CREATING NEW DATABASE CONNECTIONS
=head2 connect() -- multiple argument form
# remote database
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100);
# local (non-server) database
$db = Ace->connect(-path => '/usr/local/acedb);
Use Ace::connect() to establish a connection to a networked or local
AceDB database. To establish a connection to an AceDB server, use the
B<-host> and/or B<-port> arguments. For a local server, use the
B<-port> argument. The database must be up and running on the
indicated host and port prior to connecting to an AceDB server. The
full syntax is as follows:
$db = Ace->connect(-host => $host,
-port => $port,
-path => $database_path,
-program => $local_connection_program
-classmapper => $object_class,
-timeout => $timeout,
-query_timeout => $query_timeout
-cache => {cache parameters},
=item B<-program>
By default AcePerl will use its internal compiled code calls to
establish a connection to Ace servers, and will launch a I<tace>
subprocess to communicate with local Ace databases. The B<-program>
argument allows you to customize this behavior by forcing AcePerl to
use a local program to communicate with the database. This argument
should point to an executable on your system. You may use either a
complete path or a bare command name, in which case the PATH
environment variable will be consulted. For example, you could force
AcePerl to use the I<aceclient> program to connect to the remote host
by connecting this way:
-program=>'aceclient');
=item B<-classmapper>
The optional B<-classmapper> argument (alias B<-class>) points to the
class you would like to return from database queries. It is provided
for your use if you subclass Ace::Object. For example, if you have
created a subclass of Ace::Object called Ace::Object::Graphics, you
can have the database return this subclass by default by connecting
this way:
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100,
-class=>'Ace::Object::Graphics');
does not exist in the hash, a key named _DEFAULT_ will be looked for.
If that does not exist, then Ace will default to Ace::Object.
The value of B<-class> can also be an object or a classname that
implements a class_for() method. This method will receive three
arguments containing the AceDB class name, object ID and database
handle. It should return a string indicating the perl class to
create.
=item B<-timeout>
If you prefer to use a more Smalltalk-like message-passing syntax, you
can open a connection this way too:
$db = connect Ace -host=>'beta.crbm.cnrs-mop.fr',-port=>20000100;
The return value is an Ace handle to use to access the database, or
undef if the connection fails. If the connection fails, an error
message can be retrieved by calling Ace->error.
You may check the status of a connection at any time with ping(). It
will return a true value if the database is still connected. Note
that Ace will timeout clients that have been inactive for any length
of time. Long-running clients should attempt to reestablish their
connection if ping() returns false.
$db->ping() || die "not connected";
rpcace://stein.cshl.org:400000
If not provided, the port defaults to 200005
=item tace:/path/to/database
Open up the local database at F</path/to/database> using tace. Example:
tace:/~acedb/elegans
=item /path/to/database
Same as the previous.
=back
=head2 close() Method
You can explicitly close a database by calling its close() method:
$db->close();
This is not ordinarily necessary because the database will be
automatically close when it -- and all objects retrieved from it -- go
out of scope.
=head2 reopen() Method
The ACeDB socket server can time out. The reopen() method will ping
the server and if it is not answering will reopen the connection. If
the database is live (or could be resurrected), this method returns
true.
=head1 RETRIEVING ACEDB OBJECTS
Once you have established a connection and have an Ace databaes
handle, several methods can be used to query the ACE database to
retrieve objects. You can then explore the objects, retrieve specific
fields from them, or update them using the I<Ace::Object> methods.
Please see L<Ace::Object>.
=head2 fetch() method
-fill=>$fill,
-filltag=>$tag,
-total=>\$total);
@objects = $db->fetch(-query=>$query);
Ace::fetch() retrieves objects from the database based on their class
and name. You may retrieve a single object by requesting its name, or
a group of objects by fetching a name I<pattern>. A pattern contains
one or more wildcard characters, where "*" stands for zero or more
characters, and "?" stands for any single character.
array context, it will return an empty list.
When called with a class and a name pattern in a list context, fetch()
returns the list of objects that match the name. When called with a
pattern in a scalar context, fetch() returns the I<number> of objects
that match without actually retrieving them from the database. Thus,
it is similar to count().
In the examples below, the first line of code will fetch the Sequence
object whose database ID is I<D12345>. The second line will retrieve
all objects matching the pattern I<D1234*>. The third line will
return the count of objects that match the same pattern.
$object = $db->fetch(Sequence => 'D12345');
@objects = $db->fetch(Sequence => 'D1234*');
$cnt = $db->fetch(Sequence =>'D1234*');
A variety of communications and database errors may occur while
processing the request. When this happens, undef or an empty list
will be returned, and a string describing the error can be retrieved
by calling Ace->error.
When retrieving database objects, it is possible to retrieve a
"filled" or an "unfilled" object. A filled object contains the entire
contents of the object, including all tags and subtags. In the case
of certain Sequence objects, this may be a significant amount of data.
Unfilled objects consist just of the object name. They are filled in
from the database a little bit at a time as tags are requested. By
default, fetch() returns the unfilled object. This is usually a
performance win, but if you know in advance that you will be needing
the full contents of the retrieved object (for example, to display
them in a tree browser) it can be more efficient to fetch them in
filled mode. You do this by calling fetch() with the argument of
B<-fill> set to a true value.
The B<-filltag> argument, if provided, asks the database to fill in
the subtree anchored at the indicated tag. This will improve
performance for frequently-accessed subtrees. For example:
@objects = $db->fetch(-name => 'D123*',
-class => 'Sequence',
$object = $db->get($class,$name [,$fill]);
The get() method will return one and only one AceDB object
identified by its class and name. The optional $fill argument can be
used to control how much data is retrieved from the database. If $fill
is absent or undefined, then the method will return a lightweight
"stub" object that is filled with information as requested in a lazy
fashion. If $fill is the number "1" then the retrieved object contains
all the relevant information contained within the database. Any other
true value of $fill will be treated as a tag name: the returned object
will be prefilled with the subtree to the right of that tag.
Examples:
=head2 aql() method
$count = $db->aql($aql_query);
@objects = $db->aql($aql_query);
Ace::aql() will perform an AQL query on the database. In a scalar
context it returns the number of rows returned. In an array context
it returns a list of rows. Each row is an anonymous array containing
the columns returned by the query as an Ace::Object.
If an AQL error is encountered, will return undef or an empty list and
=head2 put() method
$cnt = $db->put($obj1,$obj2,$obj3);
This method will put the list of objects into the database,
overwriting like-named objects if they are already there. This can
be used to copy an object from one database to another, provided that
the models are compatible.
The method returns the count of objects successfully written into the
database. In case of an error, processing will stop at the last
object successfully written and an error message will be placed in
Ace->error();
=head2 parse() method
$object = $db->parse('data to parse');
This will parse the Ace tags contained within the "data to parse"
string, convert it into an object in the databse, and return the
resulting Ace::Object. In case of a parse error, the undefined value
will be returned and a (hopefully informative) description of the
error will be returned by Ace->error().
For example:
=head2 parse_longtext() method
$object = $db->parse($title,$text);
This will parse the long text (which may contain carriage returns and
other funny characters) and place it into the database with the given
title. In case of a parse error, the undefined value will be returned
and a (hopefully informative) description of the error will be
returned by Ace->error(); otherwise, a LongText object will be returned.
For example:
@objects = $db->parse_file('/path/to/file');
@objects = $db->parse_file('/path/to/file',1);
This will call parse() to parse each of the objects found in the
indicated .ace file, returning the list of objects successfully loaded
into the database.
By default, parsing will stop at the first object that causes a parse
error. If you wish to forge on after an error, pass a true value as
the second argument to this method.
=head2 new() method
$object = $db->new($class => $name);
This method creates a new object in the database of type $class and
name $name. If successful, it returns the newly-created object.
Otherwise it returns undef and sets $db->error().
$name may contain sprintf()-style patterns. If one of the patterns is
%d (or a variant), Acedb uses a class-specific unique numbering to return
a unique name. For example:
$paper = $db->new(Paper => 'wgb%06d');
The object is created in the database atomically. There is no chance to rollback as there is
in Ace::Object's object editing methods.
See also the Ace::Object->add() and replace() methods.
=head2 list() method
=head2 count() method
$count = $db->count($class,$pattern);
$count = $db->count(-query=>$query);
This function queries the database for a list of objects matching the
specified class and pattern, and returns the object count. For large
sets of objects this is much more time and memory effective than
fetching the entire list.
The class and name pattern are the same as the list() method above.
-chunksize=>$chunksize);
$obj = $db->fetch_many(-query=>$query);
If you expect to retrieve many objects, you can fetch an iterator
across the data set. This is friendly both in terms of network
bandwidth and memory consumption. It is simple to use:
$i = $db->fetch_many(Sequence,'*'); # all sequences!!!!
while ($obj = $i->next) {
print $obj->asTable;
B<-filled>) argument which retrieves the entire object rather than
just its name. This is efficient on a network with high latency if
you expect to be touching many parts of the object (rather than
just retrieving the value of a few tags).
B<fetch_many()> retrieves objects from the database in groups of a
certain maximum size, 40 by default. This can be tuned using the
optional B<-chunksize> argument. Chunksize is only a hint to the
database. It may return fewer objects per transaction, particularly
if the objects are large.
You may provide raw Ace query string with the B<-query> argument. If
present the B<-name> and B<-class> arguments will be ignored.
-filltag => $filltag,
-total => \$total,
-long => 1,
);
This performs a "grep" on the database, returning all object names or
text that contain the indicated grep pattern. In a scalar context
this call will return the number of matching objects. In an array
context, the list of matching objects are retrieved. There is also a
named-parameter form of the call, which allows you to specify the
number of objects to retrieve, the offset from the beginning of the
$obj = $db->new($class,$name);
$obj = $db->new(-class=>$class,
-name=>$name);
Create a new object in the database with the indicated class and name
and return a pointer to it. Will return undef if the object already
exists in the database. The object isn't actually written into the database
until you call Ace::Object::commit().
=head2 raw_query() method
$r = $db->raw_query('Model');
Send a command to the database and return its unprocessed output.
This method is necessary to gain access to features that are not yet
implemented in this module, such as model browsing and complex
queries.
=head2 classes() method
@classes = $db->classes();
@all_classes = $db->classes(1);
This method returns a list of all the object classes known to the
server. In a list context it returns an array of class names. In a
scalar context, it the number of classes defined in the database.
Ordinarily I<classes()> will return only those classes that are
exposed to the user interface for browsing, the so-called "visible"
classes. Pass a true argument to the call to retrieve non-visible
classes as well.
code
program name of acedb binary
version version of acedb binary
build build date of acedb binary in format Jan 25 2003 16:21:24
database
title name of the database
version version of the database
dbformat database format version number
directory directory in which the database is stored
session session number
user user under which server is running
write whether the server has write access
address global address - not known if this is useful
=head2 title() method
my $title = $db->title
Returns the version of the current database, equivalent
to $db->status->{database}{title};
=head2 version() method
my $version = $db->version;
Returns the version of the current database, equivalent
to $db->status->{database}{version};
=head2 date_style() method
$style = $db->date_style();
$style = $db->date_style('ace');
=head2 timestamps() method
$timestamps_on = $db->timestamps();
$db->timestamps(1);
Whenever a data object is updated, AceDB records the time and date of
the update, and the user ID it was running under. Ordinarily, the
retrieval of timestamp information is suppressed to conserve memory
and bandwidth. To turn on timestamps, call the B<timestamps()> method
with a true value. You can retrieve the current value of the setting
by calling the method with no arguments.
=head2 auto_save()
Sets or queries the I<auto_save> variable. If true, the "save"
command will be issued automatically before the connection to the
database is severed. The default is true.
Examples:
$db->auto_save(1);
$flag = $db->auto_save;
method call has returned a result value indicating a failure.
For your convenience, you can call error() in any of several ways:
print Ace->error();
print $db->error(); # $db is an Ace database handle
print $obj->error(); # $object is an Ace::Object
There's also a global named $Ace::Error that you are free to use.
=head2 datetime() and date()
This class method gets or sets the debug level. Higher integers
increase verbosity. 0 or undef turns off debug messages.
=head2 name2db()
$db = Ace->name2db($name [,$database])
This class method associates a database URL with an Ace database
object. This is used internally by the Ace::Object class in order to
discover what database they "belong" to.
=head2 cache()
Get or set the Cache::SizeAwareFileCache object, if one has been
created.
of these error codes and their significance.
=item encore()
This method may return true after you have performed one or more
read() operations, and indicates that there is more data to read. You
will not ordinarily have to call this method.
=back
=head1 BUGS
1. The ACE model should be consulted prior to updating the database.
2. There is no automatic recovery from connection errors.
3. Debugging has only one level of verbosity, despite the best
of intentions.
my $d = $DEBUG_LEVEL;
$DEBUG_LEVEL = shift if @_;
$d;
}
# Return true if the database is still connected. This is oddly convoluted
# because there are numerous things that can go wrong, including:
# 1. server has gone away
# 2. server has timed out our connection! (grrrrr)
# 3. communications channel contains unread garbage and is in an inconsistent state
sub ping {
my $self = shift;
local($SIG{PIPE})='IGNORE'; # so we don't get a fatal exception during the check
my $result = $self->raw_query('');
return unless $result; # server has gone away
return if $result=~/broken connection|client time out/; # server has timed us out
return unless $self->{database}->status() == STATUS_WAITING(); #communications oddness
return 1;
}
# Get or set the display style for dates
sub date_style {
my $self = shift;
$self->{'timestamps'} = $_[0] if defined $_[0];
return $self->{'timestamps'};
}
# Add one or more objects to the database
sub put {
my $self = shift;
my @objects = @_;
my $count = 0;
$Ace::Error = '';
foreach my $object (@objects) {
croak "Can't put a non-Ace object into an Ace database"
unless $object->isa('Ace::Object');
croak "Can't put a non-object into a database"
unless $object->isObject;
$object = $object->fetch unless $object->isRoot; # make sure we're putting root object
my $data = $object->asAce;
$data =~ s/\n/; /mg;
my $result = $self->raw_query("parse = $data");
$Ace::Error = $result if $result =~ /sorry|parse error/mi;
return $count if $Ace::Error;
$count++; # bump if succesful
}
return $count;
}
# Parse a single object and return the result as an object
sub parse {
my $self = shift;
my $ace_data = shift;
my @lines = split("\n",$ace_data);
foreach (@lines) { s/;/\\;/; } # protect semicolons
my $query = join("; ",@lines);
my $result = $self->raw_query("parse = $query");
$Ace::Error = $result=~/sorry|parse error/mi ? $result : '';
my @results = $self->_list(1,0);
close ACE;
$Ace::Error = $errors;
return @objects;
}
# Create a new Ace::Object in the indicated database
# (doesn't actually write into database until you do a commit)
sub new {
my $self = shift;
my ($class,$name) = rearrange([qw/CLASS NAME/],@_);
return if $self->fetch($class,$name);
my $obj = $self->class_for($class,$name)->new($class,$name,$self);
# Return a hash of miscellaneous status information from the server
# (to be expanded later)
sub status {
my $self = shift;
my $data = $self->raw_query('status');
study $data;
my %status;
# -Code section
my ($program) = $data=~/Program:\s+(.+)/m;
my ($aceversion) = $data=~/Version:\s+(.+)/m;
my ($build) = $data=~/Build:\s+(.+)/m;
$status{code} = { program=>$program,
version=>$aceversion,
build =>$build};
# -Database section
my ($title) = $data=~/Title:\s+(.+)/m;
my ($name) = $data=~/Name:\s+(.+)/m;
my ($release) = $data=~/Release:\s+(.+)/m;
my ($directory) = $data=~/Directory:\s+(.+)/m;
my ($session) = $data=~/Session:\s+(\d+)/m;
my ($user) = $data=~/User:\s+(.+)/m;
my ($write) = $data=~/Write Access:\s+(.+)/m;
my ($address) = $data=~/Global Address:\s+(\d+)/m;
$status{database} = {
title => $title,
version => $name,
dbformat => $release,
directory => $directory,
session => $session,
write => $write,
address => $address,
};
# other info - not all
my ($classes) = $data=~/classes:\s+(\d+)/;
my ($keys) = $data=~/keys:\s+(\d+)/;
my ($memory) = $data=~/blocks:\s+\d+,\s+allocated \(kb\):\s+(\d+)/;
$status{resources} = {
classes => $classes,
keys => $keys,
memory => $memory * 1024,
};
}
sub title {
my $self = shift;
my $status= $self->status;
$status->{database}{title};
}
sub version {
my $self = shift;
my $status= $self->status;
$status->{database}{version};
}
sub auto_save {
my $self = shift;
if ($self->db && $self->db->can('auto_save')) {
$Ace::Error = '';
# assumption of uniqueness of name is violated by some classes!
# return () unless $self->count($class,$item) == 1;
return unless $self->count($class,$item) >= 1;
# if we get here, then we've got some data to return.
# yes, we're repeating code slightly...
my @result;
my $ts = $self->{'timestamps'} ? '-T' : '';
my $result = $self->raw_query("show -j $ts");
unless ($result =~ /(\d+) object dumped/m) {
$self->raw_query("spush",'no_alert');
unshift @{$self->{iterator_stack}},$iterator;
1; # result code -- CHANGE THIS LATER
}
# horrid method that keeps the database's view of
# iterators in synch with our view
sub _restore_iterator {
my $self = shift;
my $iterator = shift;
: $self->raw_query("spick $i",'no_alert');
if ($result =~ /Keyword spick does not match/) {
# _restore_iterator will now only work for a single iterator (non-reentrantly)
$self->{no_spick}++;
$self->raw_query('spop','no_alert') foreach @$list; # empty database stack
$self->{iterator_stack} = []; # and local copy
return;
}
unless (($result =~ /The stack now holds (\d+) keyset/ && ($1 == (@$list-1) ))
Acme-123
view release on metacpan or search on metacpan
Changes
Makefile.PL
lib/Acme/123.pm
t/001_load.t
t/002_numbers.t
META.yml Module meta-data (added by MakeMaker)
Acme-24
view release on metacpan or search on metacpan
lib/Acme/24.pm view on Meta::CPAN
}
return(\@facts);
}
# Build a database of Jack Bauer facts
sub collect_facts
{
my($self, $file) = @_;
$file ||= './jackbauer.txt';
my $new_facts = $self->random_jackbauer_facts();
Acme-6502
view release on metacpan or search on metacpan
lib/Acme/6502.pm view on Meta::CPAN
Read a 32 bit word at the specified address.
=item C<read_chunk( $start, $end )>
Read a chunk of data from C<$start> to C<$end> - 1 into a string.
=item C<read_str( $addr )>
Read a carriage return terminated (0x0D) string from the
specified address.
lib/Acme/6502.pm view on Meta::CPAN
Write a 32 bit value at the specified address.
=item C<write_chunk( $addr, $string )>
Write a chunk of data to memory.
=back
=head1 DIAGNOSTICS
Acme-AbhiIsNot
view release on metacpan or search on metacpan
t/boilerplate.t
t/manifest.t
t/pod-coverage.t
t/pod.t
t/sum.t
META.yml Module meta-data (added by MakeMaker)
( run in 0.648 second using v1.01-cache-2.11-cpan-ec4f86ec37b )