Result:
found more than 193 distributions - search limited to the first 2001 files matching your query
( run in 0.613 )
ASP-NextLink
view release on metacpan or search on metacpan
NextLink.pm view on Meta::CPAN
use CGI::Carp;
use vars qw( $VERSION );
$VERSION = '0.11';
sub new {
my $class = shift;
die "Cannot call class method on an object" if ref $class;
my $linkfile = $main::Server->MapPath( shift );
my $self = {};
bless $self, $class;
$self->parse_linkfile( $linkfile );
$self;
}
sub parse_linkfile {
my ($self, $linkfile, $idx) = (shift, shift, 0);
die "Cannot call object method on class" unless ref $self;
open LNX, "<$linkfile" or die "Can't open $linkfile: $!\n";
while ( <LNX> ) {
chomp;
NextLink.pm view on Meta::CPAN
ASP::NextLink is NOT functionally equivalent to MSWC.NextLink.
Whereas each method of MSWC.NextLink takes a file argument,
ASP::NextLink takes a file argument ONLY in the constructor
( ASP::NextLink->new("linkfile") ). new() parses the linkfile
given; the information derived from this linkfile is subsequently
available only through the object returned by new().
Attempts to call object methods on a class and attempts to call
class methods on an object will both trigger an exception.
NextLink.pm view on Meta::CPAN
my $count = $nl->GetListCount();
=cut
sub GetListCount {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
$self->{_count};
}
NextLink.pm view on Meta::CPAN
Index of the current page in the link file.
=cut
sub GetListIndex {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
$self->{_url}{$ENV{SCRIPT_FILENAME}}
or die "Current page not found in $self->{_file}";
}
NextLink.pm view on Meta::CPAN
URL of the previous page in the link file.
=cut
sub GetPreviousURL {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
my $idx = $self->GetListIndex - 1;
exists( $self->{_idx}{$idx} )
? $self->{_idx}{$idx}[0] : undef;
NextLink.pm view on Meta::CPAN
Description of the previous page in the link file.
=cut
sub GetPreviousDescription {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
my $idx = $self->GetListIndex - 1;
exists( $self->{_idx}{$idx} )
? $self->{_idx}{$idx}[1] : undef;
NextLink.pm view on Meta::CPAN
URL of the next page in the link file.
=cut
sub GetNextURL {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
my $idx = $self->GetListIndex + 1;
exists( $self->{_idx}{$idx} )
? $self->{_idx}{$idx}[1] : undef;
NextLink.pm view on Meta::CPAN
Description of the next page in the link file.
=cut
sub GetNextDescription {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
my $idx = $self->GetListIndex + 1;
exists( $self->{_idx}{$idx} )
? $self->{_idx}{$idx}[1] : undef;
NextLink.pm view on Meta::CPAN
URL of the nth page in the link file.
NOTE: Index is 1-based, NOT zero-based.
=cut
sub GetNthURL {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
my $idx = shift;
$self->{_idx}{$idx}[0];
}
NextLink.pm view on Meta::CPAN
Description of the nth page in the link file.
NOTE: Index is 1-based, NOT zero-based.
=cut
sub GetNthDescription {
my $self = shift;
die "Cannot call object method on class" unless ref $self;
my $idx = shift;
$self->{_idx}{$idx}[1];
}
ASP
view release on metacpan or search on metacpan
my ($APACHE, $WIN32);
$APACHE = $Apache::ASP::VERSION;
$WIN32 = $^O =~ /win/i;
package ASP::IO;
sub TIEHANDLE { shift->new(@_) }
sub PRINT { shift->print(@_) }
sub PRINTF { shift->print(sprintf(@_)) }
sub new { bless {}, shift; }
sub print {
my $self = shift;
ASP::Print(@_);
1;
}
$VERSION='1.07';
$ASPOUT = tie *RESPONSE_FH, 'ASP::IO';
select RESPONSE_FH unless $APACHE;
$SIG{__WARN__} = sub { ASP::Print(@_) };
sub _END { &$_() for @DeathHooks; @DeathHooks = (); 1; }
=head1 NAME
ASP - a Module for ASP (PerlScript) Programming
$Request->ServerVariables are only stuffed into %ENV on Win32
platforms, as Apache::ASP already provides this.
ASP.pm also exports the $ScriptingNamespace symbol (Win32 only).
This symbol allows PerlScript to call subs/functions written in
another script language. For example:
<%@ language=PerlScript %>
<%
use ASP qw(:strict);
=head1 USE
=head2 use ASP qw(:basic);
Exports basic subs: Print, Warn, die, exit, param, param_count. Same
as C<use ASP;>
=head2 use ASP qw(:strict);
Allows the use of the ASP objects under C<use strict;>.
NOTE: This is not the only way to accomplish this, but I think it's
the cleanest, most convenient way.
=head2 use ASP qw(:all);
Exports all subs except those marked 'not exported'.
=head2 use ASP ();
Overloads print() and warn() and provides the $ASP::ASPOUT object.
C<warn> (or more specifically, the __WARN__ signal) has been re-routed to
output to the browser.
FYI: When implemented, this tweak led to the removal of the prototypes
Matt placed on his subs.
=head2 Warn LIST
C<Warn> is an alias for the ASP::Print method described below. The
overloading of C<warn> as described above does not currently work
in Apache::ASP, so this is provided.
=cut
sub Warn { ASP::Print(@_); }
=head2 print LIST
C<print> is overloaded to write to the browser by default. The inherent
behavior of print has not been altered and you can still use an alternate
NB: C<print> calls Print, so you could use either, but
print more closely resembles perl.
=cut
sub Print {
for (@_) {
if ( length($_) > 128000 ) {
ASP::Print( unpack('a128000a*', $_) );
} else {
$main::Response->Write($_);
Output is displayed between HTML comments so the output doesn't
interfere with page aesthetics.
=cut
sub DebugPrint { ASP::Print("<!--\n", @_, "\n-->"); }
=head2 HTMLPrint LIST
The same as C<Print> except the output is HTML-encoded so that
any HTML tags appear as sent, i.e. E<lt> becomes <, E<gt> becomes > etc.
=cut
sub HTMLPrint { map { ASP::Print($main::Server->HTMLEncode($_)) } @_ ; }
=head2 die LIST
Prints the contents of LIST to the browser and then exits. die
automatically calls $Response->End for you, it also executes any
cleanup code you have added with C<AddDeathHook>.
=cut
sub die {
ASP::Print(@_, "</BODY></HTML>");
_END;
$main::Response->End();
CORE::die();
}
Exits the current script. $Response->End is called automatically for you.
Any cleanup code added with C<AddDeathHook> is also called.
=cut
sub exit {
_END;
$main::Response->End();
CORE::exit();
}
Escapes (URL-encodes) a list. Uses ASP object method
$Server->URLEncode().
=cut
sub escape { map { $main::Server->URLEncode($_) } @_; }
=head2 unescape LIST
Unescapes a URL-encoded list. Algorithms ripped from CGI.pm
method of the same name.
=cut
sub unescape {
map {
tr/+/ /;
s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
} @_;
}
If passed an array reference, escapeHTML will return a reference
to the escaped array.
=cut
sub escapeHTML {
my ($flag, @args) = (0, @_);
@args = @{$args[0]} and $flag++ if ref $args[0] eq "ARRAY";
$_ = $main::Server->HTMLEncode($_) for @args;
$flag ? \@args : @args;
}
If passed an array reference, unescapeHTML will return a reference
to the un-escaped array.
=cut
sub unescapeHTML {
my ($flag, @args) = (0, @_);
@args = @{$args[0]} and $flag++ if ref $args[0] eq "ARRAY";
map {
s/&/&/gi;
s/"/"/gi;
NOTE: Under Apache::ASP, param() simply passes the arguments
to CGI::param() because Apache::ASP doesn't support the $obj->{Count}
property used in this function.
=cut
sub param {
if ($APACHE) {
return (wantarray) ? (CGI::param(@_)) : scalar(CGI::param(@_));
}
unless (@_) {
my @keys;
$obj->{Count} property used in this function.
=cut
sub param_count {
if ($APACHE) {
return scalar( @{[ CGI::param($_[0]) ]} );
}
if ($main::Request->ServerVariables('REQUEST_METHOD')->Item eq 'GET') {
return $main::Request->QueryString($_[0])->{Count};
<%
my $conn = Win32::OLE-new('ADODB.Connection');
$conn->Open("MyDSN");
$conn->BeginTrans();
ASP::AddDeathHook( sub { $Conn->Close if $Conn; } );
%>
Death hooks are not executed except by explicitly calling the die() or exit()
methods provided by ASP.pm.
AddDeathHook is not exported.
=cut
sub AddDeathHook { push @DeathHooks, @_; }
# These two functions are ripped from CGI.pm
sub expire_calc {
my($time) = @_;
my(%mult) = ('s'=>1,
'm'=>60,
'h'=>60*60,
'd'=>60*60*24,
Optimized and debugged.
=item Version 0.77
Overloaded warn() and subsequently removed prototypes.
Exported $ScriptingNamespace object.
Added methods escape(), unescape(), escapeHTML(), unescapeHTML().
Thanks to Bill Odom for pointing these out!
ASP4-PSGI
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
inc/Module/Install.pm view on Meta::CPAN
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
inc/Module/Install.pm view on Meta::CPAN
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
inc/Module/Install.pm view on Meta::CPAN
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
inc/Module/Install.pm view on Meta::CPAN
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
inc/Module/Install.pm view on Meta::CPAN
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
inc/Module/Install.pm view on Meta::CPAN
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
ASP4
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
inc/Module/Install.pm view on Meta::CPAN
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
inc/Module/Install.pm view on Meta::CPAN
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
inc/Module/Install.pm view on Meta::CPAN
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
inc/Module/Install.pm view on Meta::CPAN
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
inc/Module/Install.pm view on Meta::CPAN
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
inc/Module/Install.pm view on Meta::CPAN
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
ASP4x-Captcha-Imager
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
inc/Module/Install.pm view on Meta::CPAN
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
inc/Module/Install.pm view on Meta::CPAN
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
inc/Module/Install.pm view on Meta::CPAN
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
inc/Module/Install.pm view on Meta::CPAN
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
inc/Module/Install.pm view on Meta::CPAN
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
inc/Module/Install.pm view on Meta::CPAN
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
ASP4x-Linker
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
inc/Module/Install.pm view on Meta::CPAN
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
inc/Module/Install.pm view on Meta::CPAN
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
inc/Module/Install.pm view on Meta::CPAN
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
inc/Module/Install.pm view on Meta::CPAN
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
inc/Module/Install.pm view on Meta::CPAN
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
inc/Module/Install.pm view on Meta::CPAN
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
ASP4x-Router
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
inc/Module/Install.pm view on Meta::CPAN
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
inc/Module/Install.pm view on Meta::CPAN
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
inc/Module/Install.pm view on Meta::CPAN
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
inc/Module/Install.pm view on Meta::CPAN
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
inc/Module/Install.pm view on Meta::CPAN
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
inc/Module/Install.pm view on Meta::CPAN
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
AUBBC
view release on metacpan or search on metacpan
code => { level => 0, text => $BAD_MESSAGE, },
img => { level => 0, text => $BAD_MESSAGE, },
url => { level => 0, text => $BAD_MESSAGE, },
);
sub security_levels {
my ($self,@s_levels) = @_;
$do_f[10] = 0;
@s_levels
? @security_levels = @s_levels
: return @security_levels;
}
sub user_level {
my ($self,$u_level) = @_;
$do_f[10] = 0;
defined $u_level
? $user_level = $u_level
: return $user_level;
}
sub tag_security {
my ($self,%s_tags) = @_;
%s_tags
? %Tag_SecLVL = %s_tags
: return %Tag_SecLVL;
}
sub check_access {
my $tag = shift;
unless ($do_f[10]) {
$do_f[10] = 1;
($high_level, $user_key) = (scalar(@security_levels), 0);
? return 1
: return '';
}
}
sub new {
warn 'CREATING AUBBC '.$VERSION if $DEBUG_AUBBC;
if ($MEMOIZE && ! $do_f[7]) {
$do_f[7] = 1;
eval 'use Memoize' if ! defined $Memoize::VERSION;
unless ($@ || ! defined $Memoize::VERSION) {
$aubbc_error .= $@."\n" if $@;
}
return bless {};
}
sub DESTROY {
warn 'DESTROY AUBBC '.$VERSION if $DEBUG_AUBBC;
}
sub settings_prep {
$AUBBC{href_target} = $AUBBC{href_target} ? ' target="_blank"' : '';
$AUBBC{image_wrap} = $AUBBC{image_wrap} ? ' ' : '';
$AUBBC{image_border} = $AUBBC{image_border} ? '1' : '0';
$AUBBC{html_type} = $AUBBC{html_type} eq 'xhtml' || $AUBBC{html_type} eq ' /' ? ' /' : '';
}
sub settings {
my ($self,%s_hash) = @_;
foreach (keys %s_hash) {
if ('highlight_function' eq $_) {
$AUBBC{highlight} = 0;
$s_hash{$_} = check_subroutine($s_hash{$_},'');
$AUBBC{highlight_function} = $s_hash{$_} unless ! $s_hash{$_};
} else {
$AUBBC{$_} = $s_hash{$_};
}
}
$uabbc_settings .= $_ . ' =>' . $AUBBC{$_} . ', ' foreach keys %AUBBC;
warn 'AUBBC Settings Change: '.$uabbc_settings;
}
}
sub get_setting {
my ($self,$name) = @_;
return $AUBBC{$name} if exists $AUBBC{$name};
}
sub code_highlight {
my $txt = shift;
warn 'ENTER code_highlight' if $DEBUG_AUBBC;
$txt =~ s/:/:/g;
$txt =~ s/\[/[/g;
$txt =~ s/\]/]/g;
if ($AUBBC{highlight}) {
warn 'ENTER block highlight' if $DEBUG_AUBBC;
$txt =~ s/\z/<br$AUBBC{html_type}>/ if $txt !~ m/<br$AUBBC{html_type}>\z/;
$txt =~ s/(<<(?:')?(\w+)(?:')?;(?s)[^\2]+\b\2\b)/<span$AUBBC{highlight_class1}>$1<\/span>/g;
$txt =~ s/(?<![\&\$])(\#.*?(?:<br$AUBBC{html_type}>))/<span$AUBBC{highlight_class2}>$1<\/span>/g;
$txt =~ s/(\bsub\b(?:\s+))(\w+)/$1<span$AUBBC{highlight_class8}>$2<\/span>/g;
$txt =~ s/(\w+(?:\->)?(?:\w+)?((?:.+?)?)(?:;)?)/<span$AUBBC{highlight_class9}>$1<\/span>/g;
$txt =~ s/((?:&)\w+;)/<span$AUBBC{highlight_class9}>$1<\/span>/g;
$txt =~ s/('(?s).*?(?<!\)')/<span$AUBBC{highlight_class3}>$1<\/span>/g;
$txt =~ s/("(?s).*?(?<!\)")/<span$AUBBC{highlight_class4}>$1<\/span>/g;
$txt =~ s/(?<![\#|\w])(\d+)(?!\w)/<span$AUBBC{highlight_class5}>$1<\/span>/g;
$txt =~
s/(|||&&|\b(?:strict|package|return|require|for|my|sub|if|eq|ne|lt|ge|le|gt|or|xor|use|while|foreach|next|last|unless|elsif|else|not|and|until|continue|do|goto)\b)/<span$AUBBC{highlight_class6}>$1<\/span>/g;
$txt =~ s/(?<!\)((?:%|\$|\@)\w+(?:(?:[.+?]|{.+?})+|))/<span$AUBBC{highlight_class7}>$1<\/span>/g;
}
return $txt;
}
sub code_download {
if ($AUBBC{code_download}) {
$do_f[8]++;
$do_f[9] =
make_link('javascript:void(0)',$AUBBC{code_download}, "javascript:MyCodePrint('aubbcode$do_f[8]');",'');
return " id=\"aubbcode$do_f[8]\"";
} else { return ''; }
}
sub code_tag {
my ($code,$name) = @_;
if (check_access('code')) {
$name = "# $name:<br$AUBBC{html_type}>\n" if $name;
return "$name<div$AUBBC{code_class}".&code_download."><code>\n".
$AUBBC{highlight_function}->($code).
else {
return $Tag_SecLVL{code}{text};
}
}
sub make_image {
my ($align,$src,$width,$height,$alt) = @_;
my $img = "<img$align src=\"$src\"";
$img .= " width=\"$width\"" if $width;
$img .= " height=\"$height\"" if $height;
return $img." alt=\"$alt\" border=\"$AUBBC{image_border}\"$AUBBC{html_type}>";
}
sub make_link {
my ($link,$name,$javas,$targ) = @_;
my $linkd = "<a href=\"$link\"";
$linkd .= " onclick=\"$javas\"" if $javas;
$linkd .= $AUBBC{href_target} if $targ;
$linkd .= $AUBBC{href_class}.'>';
$linkd .= $name ? $name : $link;
return $linkd.'</a>';
}
sub do_ubbc {
warn 'ENTER do_ubbc' if $DEBUG_AUBBC;
$msg =~ s/\[(?:c|code)\](?s)(.+?)\[\/(?:c|code)\]/code_tag($1, '')/ge;
$msg =~ s/\[(?:c|code)=(.+?)\](?s)(.+?)\[\/(?:c|code)\]/code_tag($2, $1)/ge;
$do_f[9] = '' if $do_f[9];
$msg =~ s/\[url=(\w+\:\/\/$long_regex)\](.+?)\[\/url\]/link_check($1,fix_message($2),'',1)/ge;
$msg =~ s/(?<!["=\.\/\'\[\{\;])((?:\b\w+\b\:\/\/)$long_regex)/link_check($1,$1,'',1)/ge;
}
sub link_check {
my ($link,$name,$javas,$targ) = @_;
check_access('url')
? make_link($link,$name,$javas,$targ)
: return $Tag_SecLVL{url}{text};
}
sub fix_list {
my $list = shift;
if ($list =~ m/\[\*/) {
$list =~ s/<br$AUBBC{html_type}>//g;
my $type = 'ul';
$type = 'ol' if $list =~ s/\[\*=(\d+)\]/\[\*\]$1\|/g;
$list .= "<\/$type>";
}
return $list;
}
sub fix_image {
my ($tmp2, $tmp) = @_;
if (check_access('img')) {
if ($tmp !~ m/\A\w+:\/\/|\// || $tmp =~ m/\?|\#|\.\bjs\b\z/i) {
$tmp = "[<font color=red>$BAD_MESSAGE</font>]$tmp2";
}
else {
return $Tag_SecLVL{img}{text};
}
}
sub protect_email {
my $em = shift;
if (check_access('url')) {
my ($email1, $email2, $ran_num, $protect_email, @letters) =
('', '', '', '', split (//, $em));
$protect_email = '[' if $AUBBC{protect_email} eq 3 || $AUBBC{protect_email} eq 4;
else {
return $Tag_SecLVL{url}{text};
}
}
sub js_print {
my $self = shift;
print <<JS;
Content-type: text/javascript
/*
}
JS
exit(0);
}
sub do_build_tag {
warn 'ENTER do_build_tag' if $DEBUG_AUBBC;
foreach (keys %Build_AUBBC) {
warn 'ENTER foreach do_build_tag' if $DEBUG_AUBBC;
$msg =~ s/(\[$_\:\/\/([$Build_AUBBC{$_}[0]]+)\])/
do_sub( $_, $2 , $Build_AUBBC{$_}[2] ) || $1;
/eg if $Build_AUBBC{$_}[1] eq '1';
$msg =~ s/(\[$_\](?s)([$Build_AUBBC{$_}[0]]+)\[\/$_\])/
do_sub( $_, $2 , $Build_AUBBC{$_}[2] ) || $1;
/eg if $Build_AUBBC{$_}[1] eq '2';
$msg =~ s/(\[$_\])/
do_sub( $_, '' , $Build_AUBBC{$_}[2] ) || $1;
/eg if $Build_AUBBC{$_}[1] eq '3';
$msg =~ s/\[$_\]/
check_access($_) ? $Build_AUBBC{$_}[2] : $Tag_SecLVL{$_}{text};
/eg if $Build_AUBBC{$_}[1] eq '4';
}
}
sub do_sub {
my ($key, $term, $fun) = @_;
warn 'ENTER do_sub' if $DEBUG_AUBBC;
check_access($key)
? return $fun->($key, $term) || ''
: return $Tag_SecLVL{$key}{text};
}
sub check_subroutine {
my $name = shift;
defined $name && exists &{$name} && (ref $name eq 'CODE' || ref $name eq '')
? return \&{$name}
: return '';
}
sub add_build_tag {
my ($self,%NewTag) = @_;
warn 'ENTER add_build_tag' if $DEBUG_AUBBC;
$NewTag{function2} = $NewTag{function} || 'undefined!';
$NewTag{function} = check_subroutine($NewTag{function},'')
if $NewTag{type} ne '4';
$self->aubbc_error("Usage: add_build_tag - function 'Undefined subroutine' => $NewTag{function2}")
if ! $NewTag{function};
if ($NewTag{function}) {
$NewTag{pattern} = 'l' if $NewTag{type} eq '3' || $NewTag{type} eq '4';
if ($NewTag{type} && $NewTag{name} =~ m/\A[\w\-]+\z/ && $NewTag{pattern} =~ m/\A[lns_:\-,]+|all\z/) {
$self->aubbc_error('Usage: add_build_tag - Bad name or pattern format');
}
}
}
sub remove_build_tag {
my ($self,$name,$type) = @_;
warn 'ENTER remove_build_tag' if $DEBUG_AUBBC;
delete $Build_AUBBC{$name} if exists $Build_AUBBC{$name} && !$type; # clear one
%Build_AUBBC = () if $type && !$name; # clear all
}
sub do_unicode{
warn 'ENTER do_unicode' if $DEBUG_AUBBC;
$msg =~ s/\[utf:\/\/(\#?\w+)\]/&$1;/g;
}
sub do_smileys {
warn 'ENTER do_smileys' if $DEBUG_AUBBC;
$msg =~
s/\[$_\]/make_image('',"$AUBBC{images_url}\/smilies\/$SMILEYS{$_}",'','',$_).$AUBBC{image_wrap}/ge
foreach keys %SMILEYS;
}
sub smiley_hash {
my ($self,%s_hash) = @_;
warn 'ENTER smiley_hash' if $DEBUG_AUBBC;
if (keys %s_hash) {
%SMILEYS = %s_hash;
$do_f[6] = 1;
}
}
sub do_all_ubbc {
my ($self,$message) = @_;
warn 'ENTER do_all_ubbc' if $DEBUG_AUBBC;
$msg = defined $message ? $message : '';
if ($msg) {
check_access();
}
$msg =~ tr/\000//d if $AUBBC{aubbc_escape};
return $msg;
}
sub fix_message {
my $txt = shift;
$txt =~ s/\././g;
$txt =~ s/\:/:/g;
return $txt;
}
sub escape_aubbc {
warn 'ENTER escape_aubbc' if $DEBUG_AUBBC;
$msg =~ s/\[\[/\000[/g;
$msg =~ s/\]\]/\000]/g;
}
sub script_escape {
my ($self, $text, $option) = @_;
warn 'ENTER html_escape' if $DEBUG_AUBBC;
$text = '' unless defined $text;
if ($text) {
$text =~ s/(&|;)/$1 eq '&' ? '&' : ';'/ge;
: $text =~ s/\n/<br$AUBBC{html_type}>\n/g if !$option && $AUBBC{line_break} eq '1';
return $text;
}
}
sub html_to_text {
my ($self, $html, $option) = @_;
warn 'ENTER html_to_text' if $DEBUG_AUBBC;
$html = '' unless defined $html;
if ($html) {
$html =~ s/&/&/g;
$html =~ s/<br(?:\s?\/)?>\n?/\n/g if $AUBBC{line_break};
return $html;
}
}
sub version {
my $self = shift;
return $VERSION;
}
sub aubbc_error {
my ($self, $error) = @_;
defined $error && $error
? $aubbc_error .= $error . "\n"
: return $aubbc_error;
}
AVLTree
view release on metacpan or search on metacpan
lib/AVLTree.pm view on Meta::CPAN
use AVLTree;
# Define a function to compare two numbers i1 and i2,
# return -1 if i1 < i2, 1 if i2 > i1 and 0 otherwise
sub cmp_f = sub {
my ($i1, $i2) = @_;
return $i1<$i2?-1:($i1>$i2)?1:0;
}
lib/AVLTree.pm view on Meta::CPAN
# 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});
croak "Cannot compare items based on id"
unless defined $id1 and defined $id2;
lib/AVLTree.pm view on Meta::CPAN
=head1 METHODS
=head2 C<new>
Arg [1] : (required) A reference to a subroutine
Example : my $tree->new(\&compare);
carp "Unable to instantiate tree" unless defined $tree;
Description : Creates a new AVL tree object.
lib/AVLTree.pm view on Meta::CPAN
automatically be notified of progress on your bug as I make changes.
=head1 CONTRIBUTING
You can obtain the most recent development version of this module via the GitHub
repository at https://github.com/avullo/AVLTree. Please feel free to submit bug
reports, patches etc.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
AWS-ARN
view release on metacpan or search on metacpan
lib/AWS/ARN.pm view on Meta::CPAN
use Types::Standard qw/Str/;
use Type::Utils;
our $VERSION = '0.007';
use overload '""' => sub {
shift->arn;
};
my $partitionRe = my $serviceRe = qr{[\w-]+};
my $regionRe = qr{[\w-]*};
lib/AWS/ARN.pm view on Meta::CPAN
as Str,
where { m{^$resource_idRe$} },
message { "$_ is not a valid AWS Resource" },
);
sub _split_arn {
my $self = shift;
my ($index) = @_;
return "" unless $self->_has_arn;
my @parts = split( /:/, $self->arn, 6 );
return $parts[$index||0]||"";
lib/AWS/ARN.pm view on Meta::CPAN
isa => $ArnPartition,
lazy => 1,
builder => '_build_partition',
clearer => '_clear_partition',
default => 'aws',
trigger => sub { shift->_clear_arn },
);
has service => (
is => 'rw',
isa => $ArnService,
lazy => 1,
required => 1,
builder => '_build_service',
clearer => '_clear_service',
trigger => sub { shift->_clear_arn },
);
has region => (
is => 'rw',
isa => $ArnRegion,
lazy => 1,
builder => '_build_region',
clearer => '_clear_region',
trigger => sub { shift->_clear_arn },
);
has account_id => (
is => 'rw',
isa => $ArnAccountID,
lazy => 1,
builder => '_build_account_id',
clearer => '_clear_account_id',
trigger => sub { shift->_clear_arn },
);
has resource_id => (
is => 'rw',
isa => $ArnResourceID,
lazy => 1,
builder => '_build_resource_id',
clearer => '_clear_resource_id',
trigger => sub { shift->_clear_arn },
);
sub _build_arn {
my $self = shift;
my $arn = join( ':',
'arn',
$self->partition,
$self->service,
lib/AWS/ARN.pm view on Meta::CPAN
$self->account_id,
$self->resource_id,
);
}
sub _build_partition {
shift->_split_arn( 1 )
}
sub _build_service {
shift->_split_arn( 2 )
}
sub _build_region {
shift->_split_arn( 3 )
}
sub _build_account_id {
shift->_split_arn( 4 )
}
sub _build_resource_id {
shift->_split_arn( 5 )
}
sub _trigger_arn {
my $self = shift;
$self->_clear_partition;
$self->_clear_service;
$self->_clear_region;
$self->_clear_account_id;
$self->_clear_resource_id;
}
around BUILDARGS => sub {
my ( $orig, $class, @args ) = @_;
return { arn => $args[0] }
if @args == 1 && !ref $args[0];
lib/AWS/ARN.pm view on Meta::CPAN
=head2 resource_id
The resource identifier. This part of the ARN can be the name or ID of the resource or a resource path.
For example, user/Bob for an IAM user or instance/i-1234567890abcdef0 for an EC2 instance. Some resource
identifiers include a parent resource (sub-resource-type/parent-resource/sub-resource) or a qualifier such
as a version (resource-type:resource-name:qualifier).
=head1 NOTES
=over
AWS-CLI-Config
view release on metacpan or search on metacpan
lib/AWS/CLI/Config.pm view on Meta::CPAN
no strict 'refs';
*{__PACKAGE__ . "::$name"} = _mk_accessor($name, %{$opts});
}
}
sub _mk_accessor {
my $attr = shift;
my %opt = @_;
my $env_var = $opt{env};
my $profile_key = $opt{key} || $attr;
return sub {
if ($env_var && exists $ENV{$env_var} && $ENV{$env_var}) {
return $ENV{$env_var};
}
my $profile = shift || _default_profile();
lib/AWS/CLI/Config.pm view on Meta::CPAN
return undef;
};
}
sub credentials {
my $profile = shift || _default_profile();
$CREDENTIALS ||= _parse(
(exists $ENV{AWS_CONFIG_FILE} and $ENV{AWS_CONFIG_FILE})
? $ENV{AWS_CONFIG_FILE}
lib/AWS/CLI/Config.pm view on Meta::CPAN
$CREDENTIALS_PROFILE_OF{$profile} ||=
AWS::CLI::Config::Profile->new($CREDENTIALS->{$profile});
return $CREDENTIALS_PROFILE_OF{$profile};
}
sub config {
my $profile = shift || _default_profile();
$CONFIG ||= _parse(
(exists $ENV{AWS_CONFIG_FILE} and $ENV{AWS_CONFIG_FILE})
? $ENV{AWS_CONFIG_FILE}
lib/AWS/CLI/Config.pm view on Meta::CPAN
$CONFIG_PROFILE_OF{$profile} ||=
AWS::CLI::Config::Profile->new($CONFIG->{$profile});
return $CONFIG_PROFILE_OF{$profile};
}
sub _base_dir {
($^O eq 'MSWin32') ? $ENV{USERPROFILE} : $ENV{HOME};
}
sub _default_dir {
File::Spec->catdir(_base_dir(), '.aws');
}
sub _default_profile {
(exists $ENV{AWS_DEFAULT_PROFILE} && $ENV{AWS_DEFAULT_PROFILE})
? $ENV{AWS_DEFAULT_PROFILE}
: $DEFAULT_PROFILE;
}
# This only supports one level of nesting, but it seems AWS config files
# themselves only have but one level
sub _parse {
my $file = shift;
my $profile = shift || _default_profile();
my $hash = {};
my $nested = {};
lib/AWS/CLI/Config.pm view on Meta::CPAN
use 5.008001;
use strict;
use warnings;
sub new {
my $class = shift;
my $data = @_ ? @_ > 1 ? { @_ } : shift : {};
return bless $data, $class;
}
sub AUTOLOAD {
our $AUTOLOAD;
my $self = shift;
return if $AUTOLOAD =~ /DESTROY/;
my $method = $AUTOLOAD;
$method =~ s/.*:://;
no strict 'refs';
*{$AUTOLOAD} = sub {
return shift->{$method}
};
return $self->{$method};
}
AWS-CLIWrapper
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
my $AWSCLI_VERSION = undef;
my $DEFAULT_CATCH_ERROR_RETRIES = 3;
my $DEFAULT_CATCH_ERROR_MIN_DELAY = 3;
my $DEFAULT_CATCH_ERROR_MAX_DELAY = 10;
sub new {
my($class, %param) = @_;
my $region = $param{region};
my @opt = ();
lib/AWS/CLIWrapper.pm view on Meta::CPAN
}, $class;
return $self;
}
sub region { shift->{region} }
sub awscli_path {
my ($self) = @_;
return $self->{awscli_path};
}
sub awscli_version {
my ($self) = @_;
unless (defined $AWSCLI_VERSION) {
$AWSCLI_VERSION = do {
my $awscli_path = $self->awscli_path;
my $vs = qx($awscli_path --version 2>&1) || '';
lib/AWS/CLIWrapper.pm view on Meta::CPAN
};
}
return $AWSCLI_VERSION;
}
sub catch_error_pattern {
my ($self) = @_;
return $ENV{AWS_CLIWRAPPER_CATCH_ERROR_PATTERN}
if defined $ENV{AWS_CLIWRAPPER_CATCH_ERROR_PATTERN};
lib/AWS/CLIWrapper.pm view on Meta::CPAN
if defined $self->{param}->{catch_error_pattern};
return;
}
sub catch_error_retries {
my ($self) = @_;
my $retries = defined $ENV{AWS_CLIWRAPPER_CATCH_ERROR_RETRIES}
? $ENV{AWS_CLIWRAPPER_CATCH_ERROR_RETRIES}
: defined $self->{param}->{catch_error_retries}
lib/AWS/CLIWrapper.pm view on Meta::CPAN
$retries = $DEFAULT_CATCH_ERROR_RETRIES if $retries < 0;
return $retries;
}
sub catch_error_min_delay {
my ($self) = @_;
my $min_delay = defined $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MIN_DELAY}
? $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MIN_DELAY}
: defined $self->{param}->{catch_error_min_delay}
lib/AWS/CLIWrapper.pm view on Meta::CPAN
$min_delay = $DEFAULT_CATCH_ERROR_MIN_DELAY if $min_delay < 0;
return $min_delay;
}
sub catch_error_max_delay {
my ($self) = @_;
my $min_delay = $self->catch_error_min_delay;
my $max_delay = defined $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MAX_DELAY}
lib/AWS/CLIWrapper.pm view on Meta::CPAN
$max_delay = $min_delay if $min_delay > $max_delay;
return $max_delay;
}
sub catch_error_delay {
my ($self) = @_;
my $min = $self->catch_error_min_delay;
my $max = $self->catch_error_max_delay;
return $min == $max ? $min : $min + (int rand $max - $min);
}
sub param2opt {
my($k, $v) = @_;
my @v;
$k =~ s/_/-/g;
lib/AWS/CLIWrapper.pm view on Meta::CPAN
return ($k, @v);
}
# >= 0.14.0 : Key, Values, Value, Name
# < 0.14.0 : key, values, value, name
sub _compat_kv_uc {
my $v = shift;
my $type = ref $v;
if ($type && $type eq 'HASH') {
for my $hk (keys %$v) {
lib/AWS/CLIWrapper.pm view on Meta::CPAN
}
}
return $v;
}
# sub _compat_kv_lc {
# my $v = shift;
# my $type = ref $v;
# if ($type && $type eq 'HASH') {
# for my $hk (keys %$v) {
lib/AWS/CLIWrapper.pm view on Meta::CPAN
# return $v;
# }
# Drop support < 0.14.0 for preventing execute aws command in loading this module
*_compat_kv = *_compat_kv_uc;
sub json { $_[0]->{json} }
sub _execute {
my $self = shift;
my $service = shift;
my $operation = shift;
my @cmd = ($self->awscli_path, @{$self->{opt}}, $service, $operation);
if ($service eq 'ec2' && $operation eq 'wait') {
lib/AWS/CLIWrapper.pm view on Meta::CPAN
return $ret;
}
}
sub _run {
my ($self, $opt, $cmd) = @_;
my $ret;
if (exists $opt->{'nofork'} && $opt->{'nofork'}) {
# better for perl debugger
lib/AWS/CLIWrapper.pm view on Meta::CPAN
}
return $ret;
}
sub _handle {
my ($self, $service, $operation, $ret) = @_;
if ($ret->{exit_code} == 0 && $ret->{timeout} == 0) {
my $json = $ret->{stdout};
warn sprintf("%s.%s[%s]: %s\n",
lib/AWS/CLIWrapper.pm view on Meta::CPAN
# aws s3 returns null HTTP body, so failed to parse as JSON
# Temporary disable __DIE__ handler to prevent the
# exception from decode() from catching by outer
# __DIE__ handler.
local $SIG{__DIE__} = sub {};
$self->json->decode($json);
};
if ($@) {
if ($ENV{AWSCLI_DEBUG}) {
lib/AWS/CLIWrapper.pm view on Meta::CPAN
return;
}
}
# aws help | col -b | perl -ne 'if (/^AVAILABLE/.../^[A-Z]/) { s/^\s+o\s+// or next; chomp; next if $_ eq 'help'; my $sn = $_; $sn =~ s/-/_/g; printf "sub %-18s { shift->_execute('"'"'%s'"'"', \@_) }\n", $sn, $_ }'
# aws help | col -b | perl -ne 'if (/^AVAILABLE/.../^[A-Z]/) { s/^\s+o\s+// or next; chomp; next if $_ eq 'help'; my $sn = $_; $sn =~ s/-/_/g; printf "=item B<%s>(\$operation:Str, \$param:HashRef, %%opt:Hash)\n\n", $sn}'
# =item B<s3>($operation:Str, $path:ArrayRef, $param:HashRef, %opt:Hash)
sub accessanalyzer { shift->_execute('accessanalyzer', @_) }
sub account { shift->_execute('account', @_) }
sub acm { shift->_execute('acm', @_) }
sub acm_pca { shift->_execute('acm-pca', @_) }
sub alexaforbusiness { shift->_execute('alexaforbusiness', @_) }
sub amp { shift->_execute('amp', @_) }
sub amplify { shift->_execute('amplify', @_) }
sub amplifybackend { shift->_execute('amplifybackend', @_) }
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', @_) }
sub applicationcostprofiler { shift->_execute('applicationcostprofiler', @_) }
sub appmesh { shift->_execute('appmesh', @_) }
sub apprunner { shift->_execute('apprunner', @_) }
sub appstream { shift->_execute('appstream', @_) }
sub appsync { shift->_execute('appsync', @_) }
sub arc_zonal_shift { shift->_execute('arc-zonal-shift', @_) }
sub athena { shift->_execute('athena', @_) }
sub auditmanager { shift->_execute('auditmanager', @_) }
sub autoscaling { shift->_execute('autoscaling', @_) }
sub autoscaling_plans { shift->_execute('autoscaling-plans', @_) }
sub backup { shift->_execute('backup', @_) }
sub backup_gateway { shift->_execute('backup-gateway', @_) }
sub backupstorage { shift->_execute('backupstorage', @_) }
sub batch { shift->_execute('batch', @_) }
sub billingconductor { shift->_execute('billingconductor', @_) }
sub braket { shift->_execute('braket', @_) }
sub budgets { shift->_execute('budgets', @_) }
sub ce { shift->_execute('ce', @_) }
sub chime { shift->_execute('chime', @_) }
sub chime_sdk_identity { shift->_execute('chime-sdk-identity', @_) }
sub chime_sdk_media_pipelines { shift->_execute('chime-sdk-media-pipelines', @_) }
sub chime_sdk_meetings { shift->_execute('chime-sdk-meetings', @_) }
sub chime_sdk_messaging { shift->_execute('chime-sdk-messaging', @_) }
sub chime_sdk_voice { shift->_execute('chime-sdk-voice', @_) }
sub cleanrooms { shift->_execute('cleanrooms', @_) }
sub cloud9 { shift->_execute('cloud9', @_) }
sub cloudcontrol { shift->_execute('cloudcontrol', @_) }
sub clouddirectory { shift->_execute('clouddirectory', @_) }
sub cloudformation { shift->_execute('cloudformation', @_) }
sub cloudfront { shift->_execute('cloudfront', @_) }
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', @_) }
sub codeguru_reviewer { shift->_execute('codeguru-reviewer', @_) }
sub codeguru_security { shift->_execute('codeguru-security', @_) }
sub codeguruprofiler { shift->_execute('codeguruprofiler', @_) }
sub codepipeline { shift->_execute('codepipeline', @_) }
sub codestar { shift->_execute('codestar', @_) }
sub codestar_connections { shift->_execute('codestar-connections', @_) }
sub codestar_notifications { shift->_execute('codestar-notifications', @_) }
sub cognito_identity { shift->_execute('cognito-identity', @_) }
sub cognito_idp { shift->_execute('cognito-idp', @_) }
sub cognito_sync { shift->_execute('cognito-sync', @_) }
sub comprehend { shift->_execute('comprehend', @_) }
sub comprehendmedical { shift->_execute('comprehendmedical', @_) }
sub compute_optimizer { shift->_execute('compute-optimizer', @_) }
sub configservice { shift->_execute('configservice', @_) }
sub configure { shift->_execute('configure', @_) }
sub connect { shift->_execute('connect', @_) }
sub connect_contact_lens { shift->_execute('connect-contact-lens', @_) }
sub connectcampaigns { shift->_execute('connectcampaigns', @_) }
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', @_) }
sub directconnect { shift->_execute('directconnect', @_) }
sub discovery { shift->_execute('discovery', @_) }
sub dlm { shift->_execute('dlm', @_) }
sub dms { shift->_execute('dms', @_) }
sub docdb { shift->_execute('docdb', @_) }
sub docdb_elastic { shift->_execute('docdb-elastic', @_) }
sub drs { shift->_execute('drs', @_) }
sub ds { shift->_execute('ds', @_) }
sub dynamodb { shift->_execute('dynamodb', @_) }
sub dynamodbstreams { shift->_execute('dynamodbstreams', @_) }
sub ebs { shift->_execute('ebs', @_) }
sub ec2 { shift->_execute('ec2', @_) }
sub ec2_instance_connect { shift->_execute('ec2-instance-connect', @_) }
sub ecr { shift->_execute('ecr', @_) }
sub ecr_public { shift->_execute('ecr-public', @_) }
sub ecs { shift->_execute('ecs', @_) }
sub efs { shift->_execute('efs', @_) }
sub eks { shift->_execute('eks', @_) }
sub elastic_inference { shift->_execute('elastic-inference', @_) }
sub elasticache { shift->_execute('elasticache', @_) }
sub elasticbeanstalk { shift->_execute('elasticbeanstalk', @_) }
sub elastictranscoder { shift->_execute('elastictranscoder', @_) }
sub elb { shift->_execute('elb', @_) }
sub elbv2 { shift->_execute('elbv2', @_) }
sub emr { shift->_execute('emr', @_) }
sub emr_containers { shift->_execute('emr-containers', @_) }
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', @_) }
sub frauddetector { shift->_execute('frauddetector', @_) }
sub fsx { shift->_execute('fsx', @_) }
sub gamelift { shift->_execute('gamelift', @_) }
sub gamesparks { shift->_execute('gamesparks', @_) }
sub glacier { shift->_execute('glacier', @_) }
sub globalaccelerator { shift->_execute('globalaccelerator', @_) }
sub glue { shift->_execute('glue', @_) }
sub grafana { shift->_execute('grafana', @_) }
sub greengrass { shift->_execute('greengrass', @_) }
sub greengrassv2 { shift->_execute('greengrassv2', @_) }
sub groundstation { shift->_execute('groundstation', @_) }
sub guardduty { shift->_execute('guardduty', @_) }
sub health { shift->_execute('health', @_) }
sub healthlake { shift->_execute('healthlake', @_) }
sub history { shift->_execute('history', @_) }
sub honeycode { shift->_execute('honeycode', @_) }
sub iam { shift->_execute('iam', @_) }
sub identitystore { shift->_execute('identitystore', @_) }
sub imagebuilder { shift->_execute('imagebuilder', @_) }
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', @_) }
sub iottwinmaker { shift->_execute('iottwinmaker', @_) }
sub iotwireless { shift->_execute('iotwireless', @_) }
sub ivs { shift->_execute('ivs', @_) }
sub ivs_realtime { shift->_execute('ivs-realtime', @_) }
sub ivschat { shift->_execute('ivschat', @_) }
sub kafka { shift->_execute('kafka', @_) }
sub kafkaconnect { shift->_execute('kafkaconnect', @_) }
sub kendra { shift->_execute('kendra', @_) }
sub kendra_ranking { shift->_execute('kendra-ranking', @_) }
sub keyspaces { shift->_execute('keyspaces', @_) }
sub kinesis { shift->_execute('kinesis', @_) }
sub kinesis_video_archived_media { shift->_execute('kinesis-video-archived-media', @_) }
sub kinesis_video_media { shift->_execute('kinesis-video-media', @_) }
sub kinesis_video_signaling { shift->_execute('kinesis-video-signaling', @_) }
sub kinesis_video_webrtc_storage { shift->_execute('kinesis-video-webrtc-storage', @_) }
sub kinesisanalytics { shift->_execute('kinesisanalytics', @_) }
sub kinesisanalyticsv2 { shift->_execute('kinesisanalyticsv2', @_) }
sub kinesisvideo { shift->_execute('kinesisvideo', @_) }
sub kms { shift->_execute('kms', @_) }
sub lakeformation { shift->_execute('lakeformation', @_) }
sub lambda { shift->_execute('lambda', @_) }
sub lex_models { shift->_execute('lex-models', @_) }
sub lex_runtime { shift->_execute('lex-runtime', @_) }
sub lexv2_models { shift->_execute('lexv2-models', @_) }
sub lexv2_runtime { shift->_execute('lexv2-runtime', @_) }
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', @_) }
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', @_) }
sub migration_hub_refactor_spaces { shift->_execute('migration-hub-refactor-spaces', @_) }
sub migrationhub_config { shift->_execute('migrationhub-config', @_) }
sub migrationhuborchestrator { shift->_execute('migrationhuborchestrator', @_) }
sub migrationhubstrategy { shift->_execute('migrationhubstrategy', @_) }
sub mobile { shift->_execute('mobile', @_) }
sub mq { shift->_execute('mq', @_) }
sub mturk { shift->_execute('mturk', @_) }
sub mwaa { shift->_execute('mwaa', @_) }
sub neptune { shift->_execute('neptune', @_) }
sub network_firewall { shift->_execute('network-firewall', @_) }
sub networkmanager { shift->_execute('networkmanager', @_) }
sub nimble { shift->_execute('nimble', @_) }
sub oam { shift->_execute('oam', @_) }
sub omics { shift->_execute('omics', @_) }
sub opensearch { shift->_execute('opensearch', @_) }
sub opensearchserverless { shift->_execute('opensearchserverless', @_) }
sub opsworks { shift->_execute('opsworks', @_) }
sub opsworks_cm { shift->_execute('opsworks-cm', @_) }
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', @_) }
sub pinpoint_email { shift->_execute('pinpoint-email', @_) }
sub pinpoint_sms_voice { shift->_execute('pinpoint-sms-voice', @_) }
sub pinpoint_sms_voice_v2 { shift->_execute('pinpoint-sms-voice-v2', @_) }
sub pipes { shift->_execute('pipes', @_) }
sub polly { shift->_execute('polly', @_) }
sub pricing { shift->_execute('pricing', @_) }
sub privatenetworks { shift->_execute('privatenetworks', @_) }
sub proton { shift->_execute('proton', @_) }
sub qldb { shift->_execute('qldb', @_) }
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', @_) }
sub resourcegroupstaggingapi { shift->_execute('resourcegroupstaggingapi', @_) }
sub robomaker { shift->_execute('robomaker', @_) }
sub rolesanywhere { shift->_execute('rolesanywhere', @_) }
sub route53 { shift->_execute('route53', @_) }
sub route53_recovery_cluster { shift->_execute('route53-recovery-cluster', @_) }
sub route53_recovery_control_config { shift->_execute('route53-recovery-control-config', @_) }
sub route53_recovery_readiness { shift->_execute('route53-recovery-readiness', @_) }
sub route53domains { shift->_execute('route53domains', @_) }
sub route53resolver { shift->_execute('route53resolver', @_) }
sub rum { shift->_execute('rum', @_) }
sub s3 { shift->_execute('s3', @_) }
sub s3api { shift->_execute('s3api', @_) }
sub s3control { shift->_execute('s3control', @_) }
sub s3outposts { shift->_execute('s3outposts', @_) }
sub sagemaker { shift->_execute('sagemaker', @_) }
sub sagemaker_a2i_runtime { shift->_execute('sagemaker-a2i-runtime', @_) }
sub sagemaker_edge { shift->_execute('sagemaker-edge', @_) }
sub sagemaker_featurestore_runtime { shift->_execute('sagemaker-featurestore-runtime', @_) }
sub sagemaker_geospatial { shift->_execute('sagemaker-geospatial', @_) }
sub sagemaker_metrics { shift->_execute('sagemaker-metrics', @_) }
sub sagemaker_runtime { shift->_execute('sagemaker-runtime', @_) }
sub savingsplans { shift->_execute('savingsplans', @_) }
sub scheduler { shift->_execute('scheduler', @_) }
sub schemas { shift->_execute('schemas', @_) }
sub sdb { shift->_execute('sdb', @_) }
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', @_) }
sub simspaceweaver { shift->_execute('simspaceweaver', @_) }
sub sms { shift->_execute('sms', @_) }
sub snow_device_management { shift->_execute('snow-device-management', @_) }
sub snowball { shift->_execute('snowball', @_) }
sub sns { shift->_execute('sns', @_) }
sub sqs { shift->_execute('sqs', @_) }
sub ssm { shift->_execute('ssm', @_) }
sub ssm_contacts { shift->_execute('ssm-contacts', @_) }
sub ssm_incidents { shift->_execute('ssm-incidents', @_) }
sub ssm_sap { shift->_execute('ssm-sap', @_) }
sub sso { shift->_execute('sso', @_) }
sub sso_admin { shift->_execute('sso-admin', @_) }
sub sso_oidc { shift->_execute('sso-oidc', @_) }
sub stepfunctions { shift->_execute('stepfunctions', @_) }
sub storagegateway { shift->_execute('storagegateway', @_) }
sub sts { shift->_execute('sts', @_) }
sub support { shift->_execute('support', @_) }
sub support_app { shift->_execute('support-app', @_) }
sub swf { shift->_execute('swf', @_) }
sub synthetics { shift->_execute('synthetics', @_) }
sub textract { shift->_execute('textract', @_) }
sub timestream_query { shift->_execute('timestream-query', @_) }
sub timestream_write { shift->_execute('timestream-write', @_) }
sub tnb { shift->_execute('tnb', @_) }
sub transcribe { shift->_execute('transcribe', @_) }
sub transfer { shift->_execute('transfer', @_) }
sub translate { shift->_execute('translate', @_) }
sub verifiedpermissions { shift->_execute('verifiedpermissions', @_) }
sub voice_id { shift->_execute('voice-id', @_) }
sub vpc_lattice { shift->_execute('vpc-lattice', @_) }
sub waf { shift->_execute('waf', @_) }
sub waf_regional { shift->_execute('waf-regional', @_) }
sub wafv2 { shift->_execute('wafv2', @_) }
sub wellarchitected { shift->_execute('wellarchitected', @_) }
sub wisdom { shift->_execute('wisdom', @_) }
sub workdocs { shift->_execute('workdocs', @_) }
sub worklink { shift->_execute('worklink', @_) }
sub workmail { shift->_execute('workmail', @_) }
sub workmailmessageflow { shift->_execute('workmailmessageflow', @_) }
sub workspaces { shift->_execute('workspaces', @_) }
sub workspaces_web { shift->_execute('workspaces-web', @_) }
sub xray { shift->_execute('xray', @_) }
1;
__END__
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<lexv2_runtime>($operation:Str, $param:HashRef, %opt:Hash)
=item B<license_manager>($operation:Str, $param:HashRef, %opt:Hash)
=item B<license_manager_linux_subscriptions>($operation:Str, $param:HashRef, %opt:Hash)
=item B<license_manager_user_subscriptions>($operation:Str, $param:HashRef, %opt:Hash)
=item B<lightsail>($operation:Str, $param:HashRef, %opt:Hash)
=item B<location>($operation:Str, $param:HashRef, %opt:Hash)
AWS-CloudFront
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
inc/Module/Install.pm view on Meta::CPAN
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
inc/Module/Install.pm view on Meta::CPAN
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
inc/Module/Install.pm view on Meta::CPAN
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
inc/Module/Install.pm view on Meta::CPAN
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
inc/Module/Install.pm view on Meta::CPAN
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
inc/Module/Install.pm view on Meta::CPAN
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
inc/Module/Install.pm view on Meta::CPAN
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
( run in 0.613 second using v1.01-cache-2.11-cpan-13bb782fe5a )