Result:
found more than 500 distributions - search limited to the first 2001 files matching your query
( run in 4.398 )
ARGV-OrDATA
view release on metacpan or search on metacpan
lib/ARGV/OrDATA.pm view on Meta::CPAN
If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
ARS-Simple
view release on metacpan or search on metacpan
lib/ARS/Simple.pm view on Meta::CPAN
{
$self->_carp("get_data_by_label() failed.\nError=$ars_errstr\nForm=$form\nQuery=$query\n");
}
else
{
if ($self->{log})
{
$self->{log}->msg(3, "get_data_by_label() no records found.\n");
}
}
return;
}
lib/ARS/Simple.pm view on Meta::CPAN
{
my $self = shift;
my $msg = join('', @_);
carp $msg;
$self->{log}->exp($msg) if ($self->{log});
}
sub _init
{
my ($self, $args) = @_;
lib/ARS/Simple.pm view on Meta::CPAN
$user = $self->{persistant}{user};
$pword = $self->{persistant}{password};
# Handle the other passed arguments
$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})
{
lib/ARS/Simple.pm view on Meta::CPAN
{
$self->{ctl} = $ctl;
}
else
{
croak(__PACKAGE__ . " object initialisation failed.\nFailed to log into Remedy server=" . $self->{server} . " as user '$user' with supplied password: $ars_errstr\n");
}
}
else
{
croak(__PACKAGE__ . " object initialisation failed, server, user and password are required\n");
lib/ARS/Simple.pm view on Meta::CPAN
=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.
The log object is expected to have methods I<exp> and I<msg>
as per the File::Log object.
=back
Sample invocation with ALL parameters:
use ARS::Simple;
use File::Log;
my $log = File::Log->new();
my $ars = ARS::Simple->new({
server => 'my_server',
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)
});
lib/ARS/Simple.pm view on Meta::CPAN
to a suitable value (eg 3000). This required the 'user' has administrator
access
=head2 _carp
Complain if something went wrong & possible add to the log file
=head2 DESTROY
Log out from ARSystem
lib/ARS/Simple.pm view on Meta::CPAN
If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
return($s) if $s->{-ctrl};
print $s->cpcon("connect()\n") if $s->{-echo};
return($s) if $s->{-ctrl} && ARS::ars_VerifyUser($s->{-ctrl});
$s->{-ctrl} =ARS::ars_Login(
$s->{-srv}, $s->{-usr}, $s->{-pswd}, $s->{-lang}
, '' # , join('-', ($ENV{COMPUTERNAME} ||$ENV{HOSTNAME} ||eval('use Sys::Hostname;hostname') ||'localhost'), getlogin() || $> || '', $$, $^T, time())
, 0, 0)
|| return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_Login', map {$_=>$s->{$_}} qw(-srv -usr -lang))));
$s->{-ctrl} && ARS::ars_SetSessionConfiguration($s->{-ctrl}, &ARS::AR_SESS_OVERRIDE_PREV_IP, 1);
$s->arsmeta();
$s
lib/ARSObject.pm view on Meta::CPAN
$r ||1;
}
sub soon { # Periodical execution of this script
# (minutes ||sub{}, ?log file, ?run command, ?soon command)
# minutes: undef - clear sched, run once || sub{} -> number
# log file: empty || full file name || var file name
# run command: empty || 'command line' || [command line] || sub{}
# soon command: empty || 'command line' || [command line] || []
# empty run command - only soon command will be scheduled
# empty soon command - sleep(minutes*60) will be used
# !defined(minutes) - soon command will be deleted from schedule
ARSperl
view release on metacpan or search on metacpan
);
$ARS::VERSION = '2.00';
$ARS::DEBUGGING = 0;
$ARS::logging_file_ptr = 0;
# definitions required for backwards compatibility
if (!defined &ARS::AR_IMPORT_OPT_CREATE) {
ASNMTAP
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my $logger = LOG_init_log4perl ( 'archive', undef, $debug );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my @archivelisttable;
applications/archive.pl view on Meta::CPAN
$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) {
applications/archive.pl view on Meta::CPAN
}
$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";
applications/archive.pl view on Meta::CPAN
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);
applications/archive.pl view on Meta::CPAN
$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";
applications/archive.pl view on Meta::CPAN
$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) {
applications/archive.pl view on Meta::CPAN
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);
applications/archive.pl view on Meta::CPAN
closedir(DIR);
}
}
foreach $dtest (@stest) {
my ($catalogID_uKey, $test) = split(/\#/, $dtest);
($command, undef) = split(/\.pl/, $test);
my ($catalogID, $uKey) = split(/_/, $catalogID_uKey);
unless ( defined $uKey ) {
$uKey = $catalogID;
$catalogID = $CATALOGID;
$catalogID_uKey = $catalogID .'_'. $uKey unless ( $catalogID eq 'CID' );
}
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);
}
}
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub removeAllNokgzipCsvSqlErrorWeekFilesOlderThenAndMoveToBackupShare {
my ($gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeWeeksEpoch, $catalogID_uKey, $command, $path, $filename) = @_;
my ($datum, $staart) = split(/\-/, $filename, 2);
if ( $staart ) {
if ( $staart eq "all.txt" ) {
applications/archive.pl view on Meta::CPAN
} 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);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv-week.txt" ) {
my ($jaar, $week) = split(/w/, $datum);
my $jaarWeekFilename = int($jaar.$week);
my ( $tWeek, $tYear ) = get_week ('yesterday');
my $jaarWeekYesterday = int(get_year('yesterday'). $tWeek);
applications/archive.pl view on Meta::CPAN
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);
applications/archive.pl view on Meta::CPAN
} 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
applications/archive.pl view on Meta::CPAN
# $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 {
applications/archive.pl view on Meta::CPAN
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";
applications/archive.pl view on Meta::CPAN
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub catAllCsvFilesYesterdayWeek {
my ($firstDayOfWeekEpoch, $yesterdayEpoch, $catalogID_uKey, $command, $path, $weekFilename, $filename) = @_;
for (my $loop = $firstDayOfWeekEpoch; $loop <= $yesterdayEpoch; $loop += 86400) {
if ($filename eq get_yearMonthDay($loop)."-$command-$catalogID_uKey-csv.txt") {
my $rvOpen = open(CAT, ">>$path/$weekFilename");
if ($rvOpen) {
$rvOpen = open(CSV, "$path/$filename");
ASP4-PSGI
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
ASP4
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
ASP4x-Captcha-Imager
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
ASP4x-Linker
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
ASP4x-Router
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
ASPEER-MakeMaker-Markdown-Pod
view release on metacpan or search on metacpan
GITHUB ATTESTATIONS
The release workflow generates GitHub artifact attestations for
distribution archives. Install the GitHub CLI with gh attestation
support and authenticate with gh auth login.
Download ASPEER-MakeMaker-Markdown-Pod-VERSION.tar.gz from a GitHub
release, MetaCPAN, or a CPAN mirror, replace VERSION, and verify it
with:
ASPEER-MakeMaker-Markdown-Publish
view release on metacpan or search on metacpan
lib/ASPEER/MakeMaker/Markdown/Publish.pm view on Meta::CPAN
project root. `publish_cloudflare` discovers those names in that order, so no
Cloudflare publication metadata is needed for the usual layout. Set
`cloudflare => {config => 'deploy/wrangler.docs.jsonc'}` inside `publish` to
select a file elsewhere. Optionally set `wrangler` to the executable path or
`environment` to an authored Wrangler environment in the same `cloudflare`
hash. Wrangler uses its own login or environment for authentication; do not
put credentials in metadata. Deployment does not change Git.
A minimal project-root `wrangler.jsonc` is:
```jsonc
lib/ASPEER/MakeMaker/Markdown/Publish.pm view on Meta::CPAN
project root. C<publish_cloudflare> discovers those names in that order, so no
Cloudflare publication metadata is needed for the usual layout. Set
C<<< cloudflare => {config => 'deploy/wrangler.docs.jsonc'} >>> inside C<publish> to
select a file elsewhere. Optionally set C<wrangler> to the executable path or
C<environment> to an authored Wrangler environment in the same C<cloudflare>
hash. Wrangler uses its own login or environment for authentication; do not
put credentials in metadata. Deployment does not change Git.
A minimal project-root C<wrangler.jsonc> is:
ASPEER-MakeMaker
view release on metacpan or search on metacpan
GitHub Attestations
The release workflow generates GitHub artifact attestations for
distribution archives. Install the GitHub CLI with gh attestation
support and authenticate with gh auth login.
Download ASPEER-MakeMaker-VERSION.tar.gz from a GitHub release,
MetaCPAN, or a CPAN mirror, replace VERSION, and verify it with:
gh attestation verify ASPEER-MakeMaker-VERSION.tar.gz --repo aspeer/pm-ASPEER-MakeMaker
template.
- A post_initialize extension that controls the install map and records
the Git revision beside VERSION_FROM.
- A retained util_sync target and method for copying the shared utility
files into an older or standalone distribution when required.
- Shared logging, file, argument-parsing, and Perl runtime construction
helpers.
Basic Usage
In a consuming Makefile.PL, load the module before calling
AUBBC
view release on metacpan or search on metacpan
examples/bench.pl view on Meta::CPAN
[right]]Right Align[[/right] = [right]Right Align[/right][br]
[[em]Emotion[/em]] = [em]Emotion[/em]
[sup]Sup[/sup][br]
[sub]Sub[/sub][br]
[pre]]Pre[[/pre] = [pre]Pre[/pre][br]
[img]]http://www.google.com/intl/en/images/about_logo.gif[[/img] =
[img]http://www.google.com/intl/en/images/about_logo.gif[/img][br][br]
[url=URL]]Name[[/url] = [url=http://www.google.com]http://www.google.com[/url][br]
http[utf://#58]//google.com = http://google.com[br]
[email]]Email[/email] = [email]some@email.com[/email] Recommended Not to Post your email in a public area[br]
[code]]# Some Code ......
my %hash = ( stuff => { '1' => 1, '2' => 2 }, );
AVLTree
view release on metacpan or search on metacpan
#ifdef __cplusplus
extern "C" {
#endif
/*
From http://blogs.perl.org/users/nick_wellnhofer/2015/03/writing-xs-like-a-pro---perl-no-get-context-and-static-functions.html
The perlxs man page recommends to define the PERL_NO_GET_CONTEXT macro before including EXTERN.h, perl.h, and XSUB.h.
If this macro is defined, it is assumed that the interpreter context is passed as a parameter to every function.
If it's undefined, the context will typically be fetched from thread-local storage when calling the Perl API, which
incurs a performance overhead.
AWS-CLIWrapper
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub license_manager { shift->_execute('license-manager', @_) }
sub license_manager_linux_subscriptions { shift->_execute('license-manager-linux-subscriptions', @_) }
sub license_manager_user_subscriptions { shift->_execute('license-manager-user-subscriptions', @_) }
sub lightsail { shift->_execute('lightsail', @_) }
sub location { shift->_execute('location', @_) }
sub logs { shift->_execute('logs', @_) }
sub lookoutequipment { shift->_execute('lookoutequipment', @_) }
sub lookoutmetrics { shift->_execute('lookoutmetrics', @_) }
sub lookoutvision { shift->_execute('lookoutvision', @_) }
sub m2 { shift->_execute('m2', @_) }
sub machinelearning { shift->_execute('machinelearning', @_) }
sub macie { shift->_execute('macie', @_) }
sub macie2 { shift->_execute('macie2', @_) }
sub managedblockchain { shift->_execute('managedblockchain', @_) }
sub marketplace_catalog { shift->_execute('marketplace-catalog', @_) }
sub marketplace_entitlement { shift->_execute('marketplace-entitlement', @_) }
sub marketplacecommerceanalytics { shift->_execute('marketplacecommerceanalytics', @_) }
sub mediaconnect { shift->_execute('mediaconnect', @_) }
sub mediaconvert { shift->_execute('mediaconvert', @_) }
sub medialive { shift->_execute('medialive', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub secretsmanager { shift->_execute('secretsmanager', @_) }
sub securityhub { shift->_execute('securityhub', @_) }
sub securitylake { shift->_execute('securitylake', @_) }
sub serverlessrepo { shift->_execute('serverlessrepo', @_) }
sub service_quotas { shift->_execute('service-quotas', @_) }
sub servicecatalog { shift->_execute('servicecatalog', @_) }
sub servicecatalog_appregistry { shift->_execute('servicecatalog-appregistry', @_) }
sub servicediscovery { shift->_execute('servicediscovery', @_) }
sub ses { shift->_execute('ses', @_) }
sub sesv2 { shift->_execute('sesv2', @_) }
sub shield { shift->_execute('shield', @_) }
sub signer { shift->_execute('signer', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<lightsail>($operation:Str, $param:HashRef, %opt:Hash)
=item B<location>($operation:Str, $param:HashRef, %opt:Hash)
=item B<logs>($operation:Str, $param:HashRef, %opt:Hash)
=item B<lookoutequipment>($operation:Str, $param:HashRef, %opt:Hash)
=item B<lookoutmetrics>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<macie2>($operation:Str, $param:HashRef, %opt:Hash)
=item B<managedblockchain>($operation:Str, $param:HashRef, %opt:Hash)
=item B<marketplace_catalog>($operation:Str, $param:HashRef, %opt:Hash)
=item B<marketplace_entitlement>($operation:Str, $param:HashRef, %opt:Hash)
=item B<marketplacecommerceanalytics>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<serverlessrepo>($operation:Str, $param:HashRef, %opt:Hash)
=item B<service_quotas>($operation:Str, $param:HashRef, %opt:Hash)
=item B<servicecatalog>($operation:Str, $param:HashRef, %opt:Hash)
=item B<servicecatalog_appregistry>($operation:Str, $param:HashRef, %opt:Hash)
=item B<servicediscovery>($operation:Str, $param:HashRef, %opt:Hash)
=item B<ses>($operation:Str, $param:HashRef, %opt:Hash)
AWS-CloudFront
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
AWS-Lambda-Quick
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
Execution creates a new role called C<perl-aws-lambda-quick> that can
be assumed by both the API Gateway (C<apigateway.amazonaws.com>) and
Lambda (C<lambda.amazonaws.com>) services. The role will have
C<AWSLambdaRole> and C<CloudWatchLogsFullAccess> policies permissioned
(so it execute the lambda function and write logs.)
You can modify this role as you see fit. For example, to give your
lambda functions the ability to access S3:
shell$ aws iam attach-role-policy \
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
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.
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
shell$ sudo ./awscli-bundle/install -i /usr/local/aws -b /usr/local/bin/aws
You'll need to configure awscli with your own personal AWS Access
Key ID and AWS Secret Access Key. You can create these from the AWS
Management console by following the guide on
L<How to quickly find and update your access keys, password, and MFA setting using the AWS Management Console|https://aws.amazon.com/blogs/security/how-to-find-update-access-keys-password-mfa-aws-management-console/>
Once you have your keys you can then use the C<configure> command
to update the aws command line utility.
shell$ aws configure
AWS-Lambda
view release on metacpan or search on metacpan
examples/cgi/WwwCounter/gifcat.pl view on Meta::CPAN
;# =====================================================
sub gifcat {
@files = @_;
$Gif = 0;
$leftpos = 0;
$logicalScreenWidth = 0;
$logicalScreenHeight = 0;
$useLocalColorTable = 0;
foreach $file (@files) {
$size = -s $file;
open(IN, "$file") || return("ERROR");
examples/cgi/WwwCounter/gifcat.pl view on Meta::CPAN
if ($pflag == 1) {
return;
}
$GifImage = "GIF89a";
$GifImage .= pack("C", $logicalScreenWidth & 0x00ff);
$GifImage .= pack("C", ($logicalScreenWidth & 0xff00) >> 8);
$GifImage .= pack("C", $logicalScreenHeight & 0x00ff);
$GifImage .= pack("C", ($logicalScreenHeight & 0xff00) >> 8);
if ($useLocalColorTable) {
$PackedFields18[0] &= ~0x80;
}
$GifImage .= pack("C", $PackedFields18[0]);
$GifImage .= pack("C", $BackgroundColorIndex);
examples/cgi/WwwCounter/gifcat.pl view on Meta::CPAN
$cnt += $SizeOfGlobalColorTable * 3;
} else {
$GlobalColorTable = "";
}
$logicalScreenWidth += $LogicalScreenWidth;
if ($logicalScreenHeight < $LogicalScreenHeight) {
$logicalScreenHeight = $LogicalScreenHeight;
}
if ($GlobalColorTableFlag) {
$globalColorTable[$Gif] = $GlobalColorTable;
if ($Gif > 0) {
if ($GlobalColorTable ne $globalColorTable[$Gif - 1]) {
AWS-S3
view release on metacpan or search on metacpan
Changelog for perl module AWS::S3
2.00 2025-01-21
- Fix using AWS::S3 for Linode E3 object store (GH #20, thanks to preaction)
- Support using Log::Any for some better debugging (as above)
0.024 2012-01-05
- Better integration with CloudFront.
- More CF-related updates are on the way.
0.023 2012-01-04
- Complete overhaul of the request-signing methodology. Amazon should not be
allowed to design any more public APIs until they learn about this little
thing we call "Uniformity"
0.022 2012-01-04
- was never actually released...we skipped from 0.021 to 0.023
AWS-SNS-Confess
view release on metacpan or search on metacpan
#!/usr/bin/perl -w
package Amazon::SNS::Topic::Mock;
use base 'Amazon::SNS::Topic';
our @log = ();
sub new
{
my ($class, %args ) = @_;
return bless \%args, $class;
}
sub Publish
{
my ($s, $msg) = @_;
push @log, $msg;
}
sub LastLogEntry
{
return $log[-1];
}
1;
package Amazon::SNS::Mock;
AWS-Signature-V2
view release on metacpan or search on metacpan
cpanfile.snapshot view on Meta::CPAN
URI::WithBase 2.20
URI::_foreign undef
URI::_generic undef
URI::_idna undef
URI::_ldap 1.12
URI::_login undef
URI::_punycode 0.04
URI::_query undef
URI::_segment undef
URI::_server undef
URI::_userpass undef
cpanfile.snapshot view on Meta::CPAN
URI::mailto undef
URI::mms undef
URI::news undef
URI::nntp undef
URI::pop undef
URI::rlogin undef
URI::rsync undef
URI::rtsp undef
URI::rtspu undef
URI::sip 0.11
URI::sips undef
AWS-Signature-V4
view release on metacpan or search on metacpan
eg/08-x509-custom-signer.pl view on Meta::CPAN
#!/usr/bin/env perl
# With the X.509 variant the private key does not have to be given to the
# module: a "signer" function receives the bytes to sign and returns the
# signature. That is how to use keys that cannot leave an HSM or a KMS.
# Here the function just uses CryptX by itself, and logs what it does.
#
# CERT_FILE=cert.pem KEY_FILE=key.pem ./08-x509-custom-signer.pl
use v5.24;
use warnings;
use experimental 'signatures';
AWS-Signature4
view release on metacpan or search on metacpan
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
AWS-XRay
view release on metacpan or search on metacpan
lib/AWS/XRay.pm view on Meta::CPAN
See https://docs.aws.amazon.com/xray/latest/devguide/xray-api-segmentdocuments.html
=over
name – The logical name of the service that handled the request, up to 200 characters.
For example, your application's name or domain name.
Names can contain Unicode letters, numbers, and whitespace, and the following symbols: _, ., :, /, %, &, #, =, +, \, -, @
=back
AXL-Client-Simple
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
inc/Module/Install/Fetch.pm view on Meta::CPAN
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
Abilities
view release on metacpan or search on metacpan
lib/Abilities.pm view on Meta::CPAN
=head2 CONSTRAINTS
Generally, an ability is a yes/no option. Either the user can or can't perform
a specific action. At times, this might not be flexible enough, and the user's
ability to perform a certain action should be constrained. For example, a user
might be granted the ability to edit posts in a blog, but this ability should
be constrained to the user's posts only. The user is not to be allowed to edit
posts created by other users. C<Abilities> supports constraints by allowing to
set a name-based constraint when granting a user/role a certain ability. Then,
checking the user's ability to perform an action can include the constraint,
for example:
lib/Abilities.pm view on Meta::CPAN
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
lib/Abilities.pm view on Meta::CPAN
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
Ido Perlmuter, C<< <ido at ido50 dot net> >>
Abstract-Meta-Class
view release on metacpan or search on metacpan
lib/Abstract/Meta/Class.pm view on Meta::CPAN
has '%.attrs' => (item_accessor => 'attr');
my $attr = DynamicInterceptor->meta->attribute('attrs');
my $obj = DynamicInterceptor->new(attrs => {a => 1, b => 2});
my $a = $obj->attr('a');
my %hook_access_log;
my $ncode_ref = sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
# or
if ($scope eq 'accessor') {
AcePerl
view release on metacpan or search on metacpan
system. It should point to the directory that contains the I<wspec>
subdirectory. User name interpolations (~acedb) are OK.
=item B<-user>
Name of user to log in as (when using socket server B<only>). If not
provided, will attempt an anonymous login.
=item B<-pass>
Password to log in with (when using socket server).
=item B<-url>
An Acedb URL that combines the server type, host, port, user and
password in a single string. See the connect() method's "single
( run in 4.398 seconds using v1.01-cache-2.11-cpan-eca53f54451 )