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
view all matches for this distribution
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
view all matches for this distribution
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
view all matches for this distribution
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;
}
view all matches for this distribution
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.
view all matches for this distribution
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
view all matches for this distribution
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};
}
view all matches for this distribution
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)
view all matches for this distribution
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
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/IP.pm view on Meta::CPAN
Creates a new AWS::IP object and sets up the cache. Requires an number for the cache timeout seconds. Optionally takes a cache path argument. If no cache path is supplied, AWS::IP will use a random temp directory. If you want to reuse the cache over ...
=cut
sub new
{
croak 'Incorrect number of args passed to AWS::IP->new()' unless @_ >= 2 && @_ <= 3;
my ($class, $cache_timeout_secs, $cache_path) = @_;
# validate args
lib/AWS/IP.pm view on Meta::CPAN
If you are checking more than one ip address, it's more efficient to pull the CIDRs you want, then use L<Net::CIDR::Set> to test if the ips are present in the CIDRs (see example in SYNOPSIS).
=cut
sub ip_is_aws
{
my ($self, $ip, $service) = @_;
croak 'Error must supply an ip address' unless $ip;
lib/AWS/IP.pm view on Meta::CPAN
Returns the entire raw IP dataset as a Perl data structure.
=cut
sub get_raw_data
{
my ($self) = @_;
my $entry = $self->{cache}->entry(CACHE_KEY);
lib/AWS/IP.pm view on Meta::CPAN
Returns an arrayref of the L<CIDRs|http://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing> in the AWS IP address data.
=cut
sub get_cidrs
{
my ($self) = @_;
[ map { $_->{ip_prefix} } @{$self->get_raw_data->{prefixes}} ];
}
lib/AWS/IP.pm view on Meta::CPAN
Returns an arrayref of CIDRs matching the provided region.
=cut
sub get_cidrs_by_region
{
my ($self, $region) = @_;
croak 'Error must provide region' unless $region;
[ map { $_->{ip_prefix} } grep { $_->{region} eq $region } @{$self->get_raw_data->{prefixes}} ];
lib/AWS/IP.pm view on Meta::CPAN
Returns an arrayref of CIDRs matching the provided service (AMAZON|EC2|CLOUDFRONT|ROUTE53|ROUTE53_HEALTHCHECKS).
=cut
sub get_cidrs_by_service
{
my ($self, $service) = @_;
croak 'Error must provide service' unless $service;
[ map { $_->{ip_prefix} } grep { $_->{service} eq $service } @{$self->get_raw_data->{prefixes}} ];
lib/AWS/IP.pm view on Meta::CPAN
Returns an arrayref of the regions in the AWS IP address data.
=cut
sub get_regions
{
my ($self) = @_;
my %regions;
for (@{$self->get_raw_data->{prefixes}})
{
lib/AWS/IP.pm view on Meta::CPAN
Returns an arrayref of the services (Amazon, EC2 etc) in the AWS IP address data.
=cut
sub get_services
{
my ($self) = @_;
my %services;
for (@{$self->get_raw_data->{prefixes}})
{
lib/AWS/IP.pm view on Meta::CPAN
Amazon's L<page|http://docs.aws.amazon.com/general/latest/gr/aws-ip-ranges.html> on AWS IP ranges.
=cut
sub _refresh_cache
{
my ($self) = @_;
my $response = HTTP::Tiny->new->get('https://ip-ranges.amazonaws.com/ip-ranges.json');
lib/AWS/IP.pm view on Meta::CPAN
{
croak "Error requesting $response->{url} $response->{code} $response->{reason}";
}
}
sub _refresh_cache_from_string
{
my ($self, $data) = @_;
my $entry = $self->{cache}->entry(CACHE_KEY);
$entry->set($data);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
our $VERSION = '1.0002';
use AWS::Lambda::Quick::Processor ();
sub import {
shift;
# where's the source code of the script calling us?
my ( undef, $file, undef ) = caller;
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
use AWS::Lambda::Quick (
name => 'hello-world',
);
sub handler {
my $data = shift;
my $name = $data->{queryStringParameters}{who} // "World";
return {
statusCode => 200,
headers => {
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
And then execute it locally. Rather than running as normal your script
will instead upload itself to AWS as a Lambda function (modifying
itself so that it no longer has a dependency on AWS::Lambda::Quick) and
handle all the other steps needed to make itself web accessible.
Running the script locally subsequent times will update the code and
AWS settings.
=head2 What This Actually Does
You probably don't care about this, but this is actually what's
going on when the script uploads itself. This is subject to change
in later versions of this utility as better ways to do things
become available (for example AWS has a HTTP API that is currently in
beta that could make some of this easier!).
By default, unless you specify extra parameters when you import
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
use AWS::Lambda::Quick (
name => 'echo',
);
sub handler {
my $data = shift;
return {
statusCode => 200,
headers => {
'Content-Type' => 'application/json',
view all matches for this distribution