Result:
found more than 265 distributions - search limited to the first 2001 files matching your query ( run in 1.352 )


AUBBC

 view release on metacpan or  search on metacpan

AUBBC.pm  view on Meta::CPAN

    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);

AUBBC.pm  view on Meta::CPAN

   ? 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.pm  view on Meta::CPAN

   $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.pm  view on Meta::CPAN

  $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;

AUBBC.pm  view on Meta::CPAN

  $txt =~ s/(?<!&#92;)((?:&#37;|\$|\@)\w+(?:(?:&#91;.+?&#93;|&#123;.+?&#125;)+|))/<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).

AUBBC.pm  view on Meta::CPAN

  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];

AUBBC.pm  view on Meta::CPAN


 $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;

AUBBC.pm  view on Meta::CPAN

  $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";
 }

AUBBC.pm  view on Meta::CPAN

  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;

AUBBC.pm  view on Meta::CPAN

  else {
   return $Tag_SecLVL{url}{text};
   }
}

sub js_print {
my $self = shift;
print <<JS;
Content-type: text/javascript

/*

AUBBC.pm  view on Meta::CPAN

}
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]]+)\])/

AUBBC.pm  view on Meta::CPAN

   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},'')

AUBBC.pm  view on Meta::CPAN

   $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();

AUBBC.pm  view on Meta::CPAN

 }
 $msg =~ tr/\000//d if $AUBBC{aubbc_escape};
 return $msg;
}

sub fix_message {
 my $txt = shift;
 $txt =~ s/\./&#46;/g;
 $txt =~ s/\:/&#58;/g;
 return $txt;
}
sub escape_aubbc {
 warn 'ENTER escape_aubbc' if $DEBUG_AUBBC;
 $msg =~ s/\[\[/\000&#91;/g;
 $msg =~ s/\]\]/\000&#93;/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 '&' ? '&amp;' : '&#59;'/ge;

AUBBC.pm  view on Meta::CPAN

   : $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/&amp;/&/g;

AUBBC.pm  view on Meta::CPAN

  $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


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;

 view all matches for this distribution


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];

 view all matches for this distribution


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};
    }

 view all matches for this distribution


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__

 view all matches for this distribution


AWS-CloudFront

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

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

	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});

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


AWS-IP

 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


AWS-Lambda-Quick

 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


    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


AWS-Lambda

 view release on metacpan or  search on metacpan

author/perl-stripper/perl-stripper/handler.pl  view on Meta::CPAN

my $stripper = Perl::Strip->new(
    cache => '/tmp/.perl-strip',
    optimise_size => 1,
);

my $app = sub {
    my $env = shift;
    my $req = Plack::Request->new($env);

    my $code = do { local $/; my $body = $req->body; <$body> };
    my $stripped = $stripper->strip($code);

author/perl-stripper/perl-stripper/handler.pl  view on Meta::CPAN

    return $res->finalize;
};

my $func = AWS::Lambda::PSGI->wrap($app);

sub handle($payload, $context) {
    return $func->($payload);
}

1;

 view all matches for this distribution


AWS-Networks

 view release on metacpan or  search on metacpan

lib/AWS/Networks.pm  view on Meta::CPAN

  );

  has netinfo => (
    is => 'ro',
    isa => 'HashRef',
    default => sub {
      my $self = shift;
      die "Can't get some properties from derived results" if (not $self->url);
      my $response = HTTP::Tiny->new->get($self->url);
      die "Error downloading URL" unless ($response->{ success });
      return decode_json($response->{ content });

lib/AWS/Networks.pm  view on Meta::CPAN

  );

  has sync_token => (
    is => 'ro',
    isa => 'DateTime',
    default => sub {
      return DateTime->from_epoch( epoch => shift->netinfo->{ syncToken } );
    },
    lazy => 1,
  );

  has networks => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub {
      return shift->netinfo->{ prefixes };
    },
    lazy => 1,
  );

  has regions => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub {
      my ($self) = @_;
      my $regions = {};
      map { $regions->{ $_->{ region } } = 1 } @{ $self->networks };
      return [ keys %$regions ];
    },
    lazy => 1,
  );

  sub by_region {
    my ($self, $region) = @_;
    return AWS::Networks->new(
      url => undef,
      sync_token => $self->sync_token,
      networks => [ grep { $_->{ region } eq $region } @{ $self->networks }  ]

lib/AWS/Networks.pm  view on Meta::CPAN

  }

  has services => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub {
      my ($self) = @_;
      my $services = {};
      map { $services->{ $_->{ service } } = 1 } @{ $self->networks };
      return [ keys %$services ];
    },
    lazy => 1,
  );

  sub by_service {
    my ($self, $service) = @_;
    return AWS::Networks->new(
      url => undef,
      sync_token => $self->sync_token,
      networks => [ grep { $_->{ service } eq $service } @{ $self->networks }  ]

lib/AWS/Networks.pm  view on Meta::CPAN

  }

  has cidrs => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub {
      my ($self) = @_;
      return [ map { $_->{ ip_prefix } } @{ $self->networks } ];
    },
    lazy => 1,
  );

 view all matches for this distribution


AWS-S3

 view release on metacpan or  search on metacpan

lib/AWS/S3.pm  view on Meta::CPAN


has 'session_token' => (
    is      => 'ro',
    isa     => 'Maybe[Str]',
    lazy    => 1,
    default => sub { $ENV{AWS_SESSION_TOKEN} },
);

has 'region' => (
    is      => 'ro',
    isa     => 'Maybe[Str]',
    lazy    => 1,
    default => sub { $ENV{AWS_REGION} },
);

has 'secure' => (
    is      => 'ro',
    isa     => 'Bool',

lib/AWS/S3.pm  view on Meta::CPAN


has 'endpoint' => (
    is      => 'ro',
    isa     => 'Str',
    lazy    => 1,
    default => sub {
        my ( $s ) = @_;

        if ( my $region = $s->region ) {
            return "s3.$region.amazonaws.com"
        } else {

lib/AWS/S3.pm  view on Meta::CPAN

);

has 'ua' => (
    is      => 'ro',
    isa     => 'LWP::UserAgent',
    default => sub { LWP::UserAgent::Determined->new }
);

has 'honor_leading_slashes' => (
    is      => 'ro',
    isa     => 'Bool',
    default => sub { 0 },
);

sub request {
    my ( $s, $type, %args ) = @_;

    my $class = "AWS::S3::Request::$type";
    load_class( $class );
    return $class->new( %args, s3 => $s, type => $type );
}    # end request()

sub owner {
    my $s = shift;

    my $type     = 'ListAllMyBuckets';
    my $request  = $s->request( $type );
    my $response = $request->request();

lib/AWS/S3.pm  view on Meta::CPAN

        id           => $xpc->findvalue( '//s3:Owner/s3:ID' ),
        display_name => $xpc->findvalue( '//s3:Owner/s3:DisplayName' ),
    );
}    # end owner()

sub buckets {
    my ( $s ) = @_;

    my $type     = 'ListAllMyBuckets';
    my $request  = $s->request( $type );
    my $response = $request->request();

lib/AWS/S3.pm  view on Meta::CPAN

    }    # end foreach()

    return @buckets;
}    # end buckets()

sub bucket {
    my ( $s, $name ) = @_;

    my ( $bucket ) = grep { $_->name eq $name } $s->buckets
      or return;
    $bucket;
}    # end bucket()

sub add_bucket {
    my ( $s, %args ) = @_;

    my $type     = 'CreateBucket';
    my $request  = $s->request(
        $type,

lib/AWS/S3.pm  view on Meta::CPAN


  # You can also set the contents with a coderef:
  # Coderef should eturn a reference, not the actual string of content:
  $new_file = $bucket->add_file(
    key       => 'foo/bar.txt',
    contents  => sub { return \"This is the contents" }
  );

  # Get the file:
  my $same_file = $bucket->file( 'foo/bar.txt' );

lib/AWS/S3.pm  view on Meta::CPAN


  # Update the contents with a scalar ref:
  $same_file->contents( \"New file contents" );

  # Update the contents with a code ref:
  $same_file->contents( sub { return \"New file contents" } );

  # Delete the file:
  $same_file->delete();

  # Iterate through lots of files:

 view all matches for this distribution


AWS-SNS-Confess

 view release on metacpan or  search on metacpan

lib/AWS/SNS/Confess.pm  view on Meta::CPAN


our @EXPORT_OK = qw/confess/;

our ($access_key_id, $secret_access_key, $topic, $sns, $sns_topic);

sub setup
{
  my (%args) = @_;
  $access_key_id = $args{access_key_id};
  $secret_access_key = $args{secret_access_key};
  $topic = $args{topic};

lib/AWS/SNS/Confess.pm  view on Meta::CPAN

  });
  $sns->service(_service_url());
  $sns_topic = $sns->GetTopic($topic);
}

sub confess
{
  my ($msg) = @_;
  my $full_message = "Runtime Error: $msg\n"
    . Devel::StackTrace->new->as_string;

  _send_msg( $full_message );
  die $msg;
}

sub _service_url
{
  die "no topic specified" unless $topic;
  if ($topic =~ m/^arn:aws:sns:([^:]+):\d+:[^:]+$/)
  {
    return "http://sns.$1.amazonaws.com";
  }
  return "http://sns.us-east-1.amazonaws.com";
}

sub _send_msg
{
  $sns_topic->Publish(shift);
}

1;

 view all matches for this distribution


AWS-SNS-Verify

 view release on metacpan or  search on metacpan

lib/AWS/SNS/Verify.pm  view on Meta::CPAN

);

has message => (
    is          => 'ro',
    lazy        => 1,
    default     => sub {
        my $self = shift;
        return JSON::decode_json($self->body);
    }
);

has certificate_string => (
    is          => 'ro',
    lazy        => 1,
    default     => sub {
        my $self = shift;
        return $self->fetch_certificate;
    }
);

has certificate => (
    is          => 'ro',
    lazy        => 1,
    default     => sub {
        my $self = shift;
        return Crypt::PK::RSA->new(\$self->certificate_string);
    }
);

lib/AWS/SNS/Verify.pm  view on Meta::CPAN

    is      => 'ro',
    lazy    => 1,
    default => 1,
);

sub fetch_certificate {
    my $self = shift;
    my $url = $self->valid_cert_url($self->message->{SigningCertURL});
    my $response = HTTP::Tiny->new->get($url);
    if ($response->{success}) {
        return $response->{content};

lib/AWS/SNS/Verify.pm  view on Meta::CPAN

    else {
        ouch $response->{status}, $response->{reason}, $response;
    }
}

sub generate_signature_string {
    my $self = shift;
    my $body = $self->message;
    my @fields;
    if ($body->{Type} eq 'Notification') {
        @fields = (qw(Message MessageId Subject Timestamp TopicArn Type)) ;

lib/AWS/SNS/Verify.pm  view on Meta::CPAN

        }
    }
    return join("\n", @parts)."\n";
}

sub decode_signature {
    my $self = shift;
    return decode_base64($self->message->{Signature});
}

sub verify {
    my $self = shift;
    my $pk = $self->certificate;
    unless ($pk->verify_message($self->decode_signature, $self->generate_signature_string, 'SHA1', 'v1.5')) {
        ouch 'Bad SNS Signature', 'Could not verify the SNS message from its signature.', $self;
    }
    return 1;
}

# See also:
# https://github.com/aws/aws-php-sns-message-validator/blob/master/src/MessageValidator.php#L22
sub valid_cert_url {
    my $self = shift;
    my ($url_string) = @_;
    $url_string ||= '';

    return $url_string unless $self->validate_signing_cert_url;

lib/AWS/SNS/Verify.pm  view on Meta::CPAN

    }

    return $url_string;
}

sub TO_JSON {
    my $self = shift;
    return unbless($self);
}

=head1 NAME

 view all matches for this distribution


AWS-SQS-Simple

 view release on metacpan or  search on metacpan

lib/AWS/SQS/Simple.pm  view on Meta::CPAN


              );

=cut

sub new {
    
    my $class = shift;
    
    my %parameter_hash;

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

$ob->create_queue->( \%params_hash )


=cut

sub create_queue {

    my $self   = shift ;
    my $params = shift ;

    my $params_to_pass = {

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

$ob->send_message->( \%params_hash )


=cut

sub send_message {

    my $self   = shift ;
    my $params = shift ;

    my $message_body = $params->{ MessageBody } ;

lib/AWS/SQS/Simple.pm  view on Meta::CPAN


$ob->receive_message->( \%params_hash )

=cut

sub receive_message {

    my $self   = shift ;
    my $params = shift ;

    my $params_to_pass = {

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

$ob->delete_message->( \%params_hash )


=cut

sub delete_message {

    my $self   = shift ;
    my $params = shift ;

    my $receipt_handle = $params->{ ReceiptHandle } ;

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

$ob->get_queue_attributes->( \%params_hash )


=cut

sub get_queue_attributes {

    my $self   = shift ;
    my $params = shift ;

    my $params_to_pass = {

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

	
This function creates and returns url as per the parameters passed.

=cut

sub _get_url {
    
    my $self        = shift ;
    my $params      = shift ;

    my $url_additional_str = $self->{ AWS_ACCOUNT_ID } . '/' . delete( $params->{ QUEUE_NAME } ) ;

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

	
This function generate signature using HMACSHA256 method and version 2.

=cut

sub _generate_signatue {

    my $self   = shift ;
    my $query  = shift ;
    
    my $secret_access_key = $self->{ SECRET_ACCESS_KEY } ;

lib/AWS/SQS/Simple.pm  view on Meta::CPAN

	
This function utf8 encodes and uri escapes the parameters passed to generate the signed string.

=cut

sub _get_signed_query {

    my $params = shift ;

    my $to_sign ;
    for my $key( sort keys %$params ) {

lib/AWS/SQS/Simple.pm  view on Meta::CPAN


    URI escape only the characters that should be escaped, according to RFC 3986

=cut

sub escape {

    my ($str) = @_;

    return uri_escape_utf8( $str,'^A-Za-z0-9\-_.~' ) ;
}

lib/AWS/SQS/Simple.pm  view on Meta::CPAN


 Calculate current TimeStamp 

=cut 

sub _generate_timestamp {

    return sprintf("%04d-%02d-%02dT%02d:%02d:%02d.000Z",
                   sub { ($_[5]+1900,
                          $_[4]+1,
                          $_[3],
                          $_[2],
                          $_[1],
                          $_[0])

lib/AWS/SQS/Simple.pm  view on Meta::CPAN


=head2 _make_request 

=cut

sub _make_request {

    my $self          = shift ;
    my $url_to_access = shift ;

    my $contents                             ;

 view all matches for this distribution


AWS-Signature-V2

 view release on metacpan or  search on metacpan

lib/AWS/Signature/V2.pm  view on Meta::CPAN

our $VERSION = "0.01";

has aws_access_key => (is => 'rw', required => 1, builder => 1);
has aws_secret_key => (is => 'rw', required => 1, builder => 1);

sub _build_aws_access_key { $ENV{AWS_ACCESS_KEY} }
sub _build_aws_secret_key { $ENV{AWS_SECRET_KEY} }

sub sign {
    my ($self, $url) = @_;
    my %eq    = map { split /=/, $_ } split /&/, $url->query();
    my %q     = map { $_ => decode_utf8( uri_unescape( $eq{$_} ) ) } keys %eq;
    $q{Keywords} =~ s/\+/ /g if $q{Keywords};
    $q{AWSAccessKeyId} = $self->aws_access_key;

lib/AWS/Signature/V2.pm  view on Meta::CPAN

    $q{Signature} = $signature;
    $url->query_form( \%q );
    $url;
}

sub signature {
    my ($self, $url) = @_;
    my %eq = map { split /=/, $_ } split /&/, $url->query();
    my %q = map { $_ => uri_unescape( $eq{$_} ) } keys %eq;
    $q{Signature};
}

 view all matches for this distribution


AWS-Signature4

 view release on metacpan or  search on metacpan

lib/AWS/Signature4.pm  view on Meta::CPAN

set, their contents are used as defaults for -acccess_key and
-secret_key.

=cut

sub new {
    my $self = shift;
    my %args = @_;

    my ($id,$secret,$token);
    if (ref $args{-security_token} && $args{-security_token}->can('access_key_id')) {

lib/AWS/Signature4.pm  view on Meta::CPAN

	secret_key => $secret,
       (defined($args{-security_token}) ? (security_token => $args{-security_token}) : ()),
    },ref $self || $self;
}

sub access_key { shift->{access_key } } 
sub secret_key { shift->{secret_key } }

=item $signer->sign($request [,$region] [,$payload_sha256_hex])

Given an HTTP::Request object, add the headers required by AWS and
then sign it with a version 4 signature by adding an "Authorization"

lib/AWS/Signature4.pm  view on Meta::CPAN


=back

=cut

sub sign {
    my $self = shift;
    my ($request,$region,$payload_sha256_hex) = @_;
    $self->_add_date_header($request);
    $self->_sign($request,$region,$payload_sha256_hex);
}

lib/AWS/Signature4.pm  view on Meta::CPAN

seconds.

=cut


sub signed_url {
    my $self    = shift;
    my ($arg1,$expires) = @_;
    
    my ($request,$uri);

lib/AWS/Signature4.pm  view on Meta::CPAN

    $uri->query_param_append('X-Amz-Signature'     => $signature);
    return $uri;
}


sub _add_date_header {
    my $self = shift;
    my $request = shift;
    my $datetime;
    unless ($datetime = $request->header('x-amz-date')) {
	$datetime    = $self->_zulu_time($request);
	$request->header('x-amz-date'=>$datetime);
    }
}

sub _scope {
    my $self    = shift;
    my ($request,$region) = @_;
    my $host     = $request->uri->host;
    my $datetime = $self->_datetime($request);
    my ($date)   = $datetime =~ /^(\d+)T/;

lib/AWS/Signature4.pm  view on Meta::CPAN

    $service ||= 's3';
    $region  ||= 'us-east-1';  # default
    return "$date/$region/$service/aws4_request";
}

sub _parse_scope {
    my $self = shift;
    my $scope = shift;
    return split '/',$scope;
}

sub _datetime {
    my $self = shift;
    my $request = shift;
    return $request->header('x-amz-date') || $self->_zulu_time($request);
}

sub _algorithm { return 'AWS4-HMAC-SHA256' }

sub _sign {
    my $self    = shift;
    my ($request,$region,$payload_sha256_hex) = @_;
    return if $request->header('Authorization'); # don't overwrite

    my $datetime = $self->_datetime($request);

lib/AWS/Signature4.pm  view on Meta::CPAN

    my $string_to_sign                   = $self->_string_to_sign($datetime,$scope,$hashed_request);
    my $signature                        = $self->_calculate_signature($secret_key,$service,$region,$date,$string_to_sign);
    $request->header(Authorization => "$algorithm Credential=$access_key/$scope, SignedHeaders=$signed_headers, Signature=$signature");
}

sub _zulu_time { 
    my $self = shift;
    my $request = shift;
    my $date     = $request->header('Date');
    my @datetime = $date ? gmtime(str2time($date)) : gmtime();
    return strftime('%Y%m%dT%H%M%SZ',@datetime);
}

sub _hash_canonical_request {
    my $self = shift;
    my ($request,$hashed_payload) = @_; # (HTTP::Request,sha256_hex($content))
    my $method           = $request->method;
    my $uri              = $request->uri;
    my $path             = $uri->path || '/';

lib/AWS/Signature4.pm  view on Meta::CPAN

    my $request_digest    = sha256_hex($canonical_request);
    
    return ($request_digest,$signed_headers);
}

sub _string_to_sign {
    my $self = shift;
    my ($datetime,$credential_scope,$hashed_request) = @_;
    return join("\n",'AWS4-HMAC-SHA256',$datetime,$credential_scope,$hashed_request);
}

lib/AWS/Signature4.pm  view on Meta::CPAN


Return just the signing key in the event you wish to roll your own signature.

=cut

sub signing_key {
    my $self = shift;
    my ($kSecret,$service,$region,$date) = @_;
    my $kDate    = hmac_sha256($date,'AWS4'.$kSecret);
    my $kRegion  = hmac_sha256($region,$kDate);
    my $kService = hmac_sha256($service,$kRegion);
    my $kSigning = hmac_sha256('aws4_request',$kService);
    return $kSigning;
}

sub _calculate_signature {
    my $self = shift;
    my ($kSecret,$service,$region,$date,$string_to_sign) = @_;
    my $kSigning = $self->signing_key($kSecret,$service,$region,$date);
    return hmac_sha256_hex($string_to_sign,$kSigning);
}

 view all matches for this distribution


AWS-XRay

 view release on metacpan or  search on metacpan

lib/AWS/XRay.pm  view on Meta::CPAN

our $TRACE_ID;
our $SEGMENT_ID;
our $ENABLED;
our $SAMPLED;
our $SAMPLING_RATE = 1;
our $SAMPLER       = sub { rand() < $SAMPLING_RATE };
our $AUTO_FLUSH    = 1;

our @PLUGINS;

our $DAEMON_HOST = "127.0.0.1";

lib/AWS/XRay.pm  view on Meta::CPAN

    ($DAEMON_HOST, $DAEMON_PORT) = split /:/, $ENV{"AWS_XRAY_DAEMON_ADDRESS"};
}

my $Sock;

sub sampling_rate {
    my $class = shift;
    if (@_) {
        $SAMPLING_RATE = shift;
    }
    $SAMPLING_RATE;
}

sub sampler {
    my $class = shift;
    if (@_) {
        $SAMPLER = shift;
    }
    $SAMPLER;
}

sub plugins {
    my $class = shift;
    if (@_) {
        @PLUGINS = @_;
        Module::Load::load $_ for @PLUGINS;
    }
    @PLUGINS;
}

sub auto_flush {
    my $class = shift;
    if (@_) {
        my $auto_flush = shift;
        if ($auto_flush != $AUTO_FLUSH) {
            $Sock->close if $Sock && $Sock->can("close");

lib/AWS/XRay.pm  view on Meta::CPAN

        $AUTO_FLUSH = $auto_flush;
    }
    $AUTO_FLUSH;
}

sub sock {
    $Sock //= AWS::XRay::Buffer->new(
        IO::Socket::INET->new(
            PeerAddr => $DAEMON_HOST || "127.0.0.1",
            PeerPort => $DAEMON_PORT || 2000,
            Proto    => "udp",
        ),
        $AUTO_FLUSH,
    );
}

sub new_trace_id {
    sprintf(
        "1-%x-%s",
        CORE::time(),
        unpack("H*", Crypt::URandom::urandom(12)),
    );
}

sub new_id {
    unpack("H*", Crypt::URandom::urandom(8));
}

sub is_valid_name {
    $_[0] =~ $VALID_NAME_REGEXP;
}

# alias for backward compatibility
*trace = \&capture;

sub capture {
    my ($name, $code) = @_;
    if (!is_valid_name($name)) {
        my $msg = "invalid segment name: $name";
        $CROAK_INVALID_NAME ? croak($msg) : carp($msg);
    }

lib/AWS/XRay.pm  view on Meta::CPAN

    }
    die $error if $error;
    return $wantarray ? @ret : $ret[0];
}

sub capture_from {
    my ($header,   $name,       $code)    = @_;
    my ($trace_id, $segment_id, $sampled) = parse_trace_header($header);

    local $AWS::XRay::SAMPLED = $sampled // $SAMPLER->();
    local $AWS::XRay::ENABLED = $AWS::XRay::SAMPLED;
    local ($AWS::XRay::TRACE_ID, $AWS::XRay::SEGMENT_ID) = ($trace_id, $segment_id);
    capture($name, $code);
}

sub parse_trace_header {
    my $header = shift or return;

    my ($trace_id, $segment_id, $sampled);
    if ($header =~ /Root=([0-9a-fA-F-]+)/) {
        $trace_id = $1;

lib/AWS/XRay.pm  view on Meta::CPAN

        $sampled = $1;
    }
    return ($trace_id, $segment_id, $sampled);
}

sub add_capture {
    my ($class, $package, @methods) = @_;
    no warnings 'redefine';
    no strict 'refs';
    for my $method (@methods) {
        my $orig = $package->can($method) or next;
        *{"${package}::${method}"} = sub {
            my @args = @_;
            capture(
                $package,
                sub {
                    my $segment = shift;
                    $segment->{metadata}->{method}  = $method;
                    $segment->{metadata}->{package} = $package;
                    $orig->(@args);
                },

lib/AWS/XRay.pm  view on Meta::CPAN


    # patch the capture
    no warnings 'redefine';
    no strict 'refs';
    my $org = \&capture;
    *capture = sub {
        my ($trace_id, $segment_id, $sampled) = parse_trace_header($ENV{_X_AMZN_TRACE_ID});
        local $AWS::XRay::SAMPLED = $sampled // $SAMPLER->();
        local $AWS::XRay::ENABLED = $AWS::XRay::SAMPLED;
        local ($AWS::XRay::TRACE_ID, $AWS::XRay::SEGMENT_ID) = ($trace_id, $segment_id);
        local *capture = $org;

lib/AWS/XRay.pm  view on Meta::CPAN


=head1 SYNOPSIS

    use AWS::XRay qw/ capture /;

    capture "myApp", sub {
        capture "remote", sub {
            # do something ...
            capture "nested", sub {
                # ...
            };
        };
        capture "myHTTP", sub {
            my $segment = shift;
            # ...
            $segment->{http} = { # modify segment document
                request => {
                    method => "GET",

lib/AWS/XRay.pm  view on Meta::CPAN

            };
        };
    };

    my $header;
    capture "source", sub {
        my $segment = shift;
        $header = $segment->trace_header;
    };
    capture_from $header, "dest", sub {
        my $segment = shift;  # is a child of "source" segment
        # ...
    };

=head1 DESCRIPTION

lib/AWS/XRay.pm  view on Meta::CPAN


$segment is a AWS::XRay::Segment object.

When $AWS::XRay::TRACE_ID is not set, generates TRACE_ID automatically.

When capture() called from other capture(), $segment is a sub segment document.

See also L<AWS X-Ray Segment Documents|https://docs.aws.amazon.com/xray/latest/devguide/xray-api-segmentdocuments.html>.

=head2 capture_from($header, $name, $code)

capture_from() parses the trace header and capture the $code with sub segment of header's segment.

=head2 parse_trace_header($header)

    my ($trace_id, $segment_id) = parse_trace_header($header);

lib/AWS/XRay.pm  view on Meta::CPAN


=head2 sampler($code)

Set/Get a code ref to sample for capture().

    AWS::XRay->sampler(sub {
        if ($some_condition) {
           return 1;
        } else {
           return 0;
        }

 view all matches for this distribution


AXL-Client-Simple

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

	*inc::Module::Install::VERSION = *VERSION;
	@inc::Module::Install::ISA     = __PACKAGE__;

}

sub import {
	my $class = shift;
	my $self  = $class->new(@_);
	my $who   = $self->_caller;

	#-------------------------------------------------------------

inc/Module/Install.pm  view on Meta::CPAN

	$MAIN = $self;

	return 1;
}

sub autoload {
	my $self = shift;
	my $who  = $self->_caller;
	my $cwd  = Cwd::getcwd();
	my $sym  = "${who}::AUTOLOAD";
	$sym->{$cwd} = sub {
		my $pwd = Cwd::getcwd();
		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}

inc/Module/Install.pm  view on Meta::CPAN

		unshift @_, ( $self, $1 );
		goto &{$self->can('call')};
	};
}

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 ) {
		local $^W;
		*{"${who}::$name"} = sub {
			${"${who}::AUTOLOAD"} = "${who}::$name";
			goto &{"${who}::AUTOLOAD"};
		};
	}
}

sub new {
	my ($class, %args) = @_;

	delete $INC{'FindBin.pm'};
	{
		# to suppress the redefine warning
		local $SIG{__WARN__} = sub {};
		require FindBin;
	}

	# ignore the prefix on extension modules built from top level.
	my $base_path = Cwd::abs_path($FindBin::Bin);

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) = @_;

	my $should_reload = 0;
	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});

inc/Module/Install.pm  view on Meta::CPAN



#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);

inc/Module/Install.pm  view on Meta::CPAN

	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
	local *FH;
	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	binmode FH;
	my $string = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";
	return $string;
}
END_NEW
sub _read {
	local *FH;
	open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
	binmode FH;
	my $string = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";
	return $string;
}
END_OLD

sub _readperl {
	my $string = Module::Install::_read($_[0]);
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
	$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
	$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
	return $string;
}

sub _readpod {
	my $string = Module::Install::_read($_[0]);
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
	return $string if $_[0] =~ /\.pod\z/;
	$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
	$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;

inc/Module/Install.pm  view on Meta::CPAN

	return $string;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
	local *FH;
	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
	binmode FH;
	foreach ( 1 .. $#_ ) {
		print FH $_[$_] or die "print($_[0]): $!";
	}
	close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
	local *FH;
	open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
	binmode FH;
	foreach ( 1 .. $#_ ) {
		print FH $_[$_] or die "print($_[0]): $!";

inc/Module/Install.pm  view on Meta::CPAN

}
END_OLD

# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version {
	my $s = shift || 0;
	my $d =()= $s =~ /(\.)/g;
	if ( $d >= 2 ) {
		# Normalise multipart versions
		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;

inc/Module/Install.pm  view on Meta::CPAN

	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

sub _cmp {
	_version($_[1]) <=> _version($_[2]);
}

# Cloned from Params::Util::_CLASS
sub _CLASS {
	(
		defined $_[0]
		and
		! ref $_[0]
		and

 view all matches for this distribution


Aard

 view release on metacpan or  search on metacpan

lib/Aard.pm  view on Meta::CPAN

	[article_length_format => 'Z2' , 2 ],
];

my $header_length = sum map { $_->[2] } @{HEADER_SPEC()};

sub decompress {
	my ($input) = @_;
	my $output = $input;
	inflate \$input => \$output;
	bunzip2 \$input => \$output if $input =~ /^BZ/;
	$output
}

sub read_at {
	my ($self, $offset, $length) = @_;
	my $fh = $self->{fh};
	my $part;
	seek $fh, $offset, 0;
	read $fh, $part, $length;
	$part
}

sub index1 {
	my ($self, $index) = @_;
	unless (exists $self->{index1}{$index}) {
		my $part = $self->read_at($self->{index1_offset} + $index * $self->{index_length}, $self->{index_length});
		$self->{index1}{$index} = [unpack $self->{index_format}, $part]
	}
	$self->{index1}{$index}
}

sub fh            { shift->{fh} }
sub sha1sum       { shift->{sha1sum} }
sub uuid          { shift->{uuid} }
sub uuid_string   { uuid_to_string shift->uuid }
sub volume        { shift->{volume} }
sub total_volumes { shift->{total_volumes} }
sub count         { shift->{index_count} }

sub meta                          { shift->{meta} }
sub article_count                 { shift->meta->{article_count} }
sub article_count_is_volume_total { shift->meta->{article_count_is_volume_total} }
sub index_language                { shift->meta->{index_language} }
sub article_language              { shift->meta->{article_language} }
sub title                         { shift->meta->{title} }
sub version                       { shift->meta->{version} }
sub description                   { shift->meta->{description} }
sub copyright                     { shift->meta->{copyright} }
sub license                       { shift->meta->{license} }
sub source                        { shift->meta->{source} }

sub key {
	my ($self, $index) = @_;
	unless (exists $self->{key}{$index}) {
		my $part = $self->read_at($self->{index2_offset} + $self->index1($index)->[0], 2);
		my $len = unpack 'S>', $part;
		read $self->{fh}, $self->{key}{$index}, $len;
	}
	$self->{key}{$index}
}

sub article {
	my ($self, $index) = @_;
	unless (exists $self->{article}{$index}) {
		my $part = $self->read_at($self->{article_offset} + $self->index1($index)->[1], 4);
		my $len = unpack 'L>', $part;
		read $self->{fh}, $part, $len;
		$self->{article}{$index} = decompress $part
	}
	$self->{article}{$index}
}

sub new {
	my ($self, $file) = @_;
	open my $fh, '<', $file or die $!;
	binmode $fh;
	my %header;
	for (@{HEADER_SPEC()}) {

 view all matches for this distribution


Abilities

 view release on metacpan or  search on metacpan

lib/Abilities.pm  view on Meta::CPAN

Receives the name of an action, and possibly a constraint, and returns a true
value if the user/role can perform the provided action.

=cut

sub can_perform {
	my ($self, $action, $constraint) = @_;

	# a super-user/super-role can do whatever they want
	return 1 if $self->is_super;

lib/Abilities.pm  view on Meta::CPAN

not to a role that inherits from that role (see L</"does_role( $role )">
instead).

=cut

sub assigned_role {
	my ($self, $role) = @_;

	return unless $role;

	foreach ($self->roles) {

lib/Abilities.pm  view on Meta::CPAN

and the 'admins' role inherits from the 'devs' role, then C<does_role('devs')>
will return true for that user (while C<assigned_role('devs')> returns false).

=cut

sub does_role {
	my ($self, $role) = @_;

	return unless $role;

	foreach (map([$_, $self->get_role($_)], $self->roles)) {

lib/Abilities.pm  view on Meta::CPAN

of actions, values will be 1 (for yes/no actions) or a single-item array-ref
with the name of a constraint (for constrained actions).

=cut

sub abilities {
	my $self = shift;

	my $abilities = {};

	# load direct actions granted to this user/role

 view all matches for this distribution


Abstract-Meta-Class

 view release on metacpan or  search on metacpan

examples/example1.pl  view on Meta::CPAN

has '$.id';

has '$.name';

has '$.password' => (
    on_change => sub {
        my ($self, $attribute, $scope, $value_ref) = @_;
        $$value_ref = sha1_hex($$value_ref);
        $self;
    }
);

has '$.email' => (
    on_change => sub {
        my ($self, $attribute, $scope, $value_ref) = @_;
        die "invalid email format:" . $$value_ref
            unless $$value_ref =~ m/^<?[^@<>]+@[^@.<>]+(?:\.[^@.<>]+)+>?$/;
        $self;
    }
);

has '$.address';
has '%.roles' ;

sub is_valid_password {
    my ($self, $password) = @_;
    !! ($self->password eq sha1_hex($password));
}


 view all matches for this distribution


Ac_me-Local

 view release on metacpan or  search on metacpan

lib/Ac_me/Local.pm  view on Meta::CPAN


=head2 function1

=cut

sub function1 {
}

=head2 function2

=cut

sub function2 {
}

=head1 AUTHOR

Thibault Duponchelle, C<< <thibault.duponchelle at gmail.com> >>

 view all matches for this distribution


AcePerl

 view release on metacpan or  search on metacpan

Ace.pm  view on Meta::CPAN


# now completely deprecated and gone
# *find_many = \&fetch_many;
# *models    = \&classes;

sub connect {
  my $class = shift;
  my ($host,$port,$user,$pass,$path,$program,
      $objclass,$timeout,$query_timeout,$database,
      $server_type,$url,$u,$p,$cache,$other);

Ace.pm  view on Meta::CPAN

  $self->_create_cache($cache) if $cache;
  $self->name2db("$self",$self);
  return $self;
}

sub reopen {
  my $self = shift;
  return 1 if $self->ping;
  my $class = ref($self->{database});
  my $database;
  if ($self->{path}) {

Ace.pm  view on Meta::CPAN

  }
  $self->{database} = $database;
  1;
}

sub class {
  my $self = shift;
  my $d = $self->{class};
  $self->{class} = shift if @_;
  $d;
}

sub class_for {
  my $self = shift;
  my ($class,$id) = @_;
  my $selected_class;

  if (my $selector = $self->class) {

Ace.pm  view on Meta::CPAN

    unless $selected_class->can('new');

  $selected_class;
}

sub process_url {
  my $class = shift;
  my $url = shift;
  my ($host,$port,$user,$pass,$path,$server_type) = ('','','','','','');

  if ($url) {  # look for host:port

Ace.pm  view on Meta::CPAN

  return ($host,$port,$user,$pass,$path,$server_type);  

}

# Return the low-level Ace::AceDB object
sub db {
  return $_[0]->{'database'};
}

# Fetch a model from the database.
# Since there are limited numbers of models, we cache
# the results internally.
sub model {
  my $self = shift;
  require Ace::Model;
  my $model       = shift;
  my $break_cycle = shift;  # for breaking cycles when following #includes
  my $key = join(':',$self,'MODEL',$model);

Ace.pm  view on Meta::CPAN

}

# cached get
# pass "1" for fill to get a full fill
# pass any other true value to get a tag fill
sub get {
  my $self = shift;
  my ($class,$name,$fill) = @_;

  # look in caches first
  my $obj = $self->memory_cache_fetch($class=>$name) 

Ace.pm  view on Meta::CPAN

  # _acedb_get() does the caching
  $obj = $self->_acedb_get($class,$name,$fill) or return;
  $obj;
}

sub _acedb_get {
  my $self = shift;
  my ($class,$name,$filltag) = @_;
  return unless $self->count($class,$name) >= 1;

  #return $self->{class}->new($class,$name,$self,1) unless $filltag;

Ace.pm  view on Meta::CPAN

#### CACHE AND CARRY CODE ####
# Be very careful here.  The key used for the memory cache is in the format
# db:class:name, but the key used for the file cache is in the format class:name.
# The difference is that the filecache has a built-in namespace but the memory
# cache doesn't.
sub memory_cache_fetch {
  my $self = shift;
  my ($class,$name) = @_;
  my $key = join ":",$self,$class,$name;
  return unless defined $MEMORY_CACHE{$key};
  carp "memory_cache hit on $class:$name"
    if Ace->debug;
  return $MEMORY_CACHE{$key};
}

sub memory_cache_store {
  my $self = shift;
  croak "Usage: memory_cache_store(\$obj)" unless @_ == 1;
  my $obj = shift;
  my $key = join ':',$obj->db,$obj->class,$obj->name;
  return if exists $MEMORY_CACHE{$key};
  carp "memory_cache store on ",$obj->class,":",$obj->name if Ace->debug;
  weaken($MEMORY_CACHE{$key} = $obj);
}

sub memory_cache_clear {
    my $self = shift;
    %MEMORY_CACHE = ();
}

sub memory_cache_delete {
  my $package = shift;
  my $obj = shift or croak "Usage: memory_cache_delete(\$obj)";
  my $key = join ':',$obj->db,$obj->class,$obj->name;
  delete $MEMORY_CACHE{$key};
}

# Call as:
# $ace->file_cache_fetch($class=>$id)
sub file_cache_fetch {
  my $self = shift;
  my ($class,$name) = @_;
  my $key = join ':',$class,$name;
  my $cache = $self->cache or return;
  my $obj   = $cache->get($key);

Ace.pm  view on Meta::CPAN

  $obj;
}

# call as
# $ace->file_cache_store($obj);
sub file_cache_store {
  my $self = shift;
  my $obj  = shift;

  return unless $obj->name;

Ace.pm  view on Meta::CPAN

    cluck "NULL OBJECT";
  }
  $cache->set($key,$obj);
}

sub file_cache_delete {
  my $self = shift;
  my $obj = shift;
  my $key = join ':',$obj->class,$obj->name;
  my $cache = $self->cache or return;

Ace.pm  view on Meta::CPAN


#### END: CACHE AND CARRY CODE ####


# Fetch one or a group of objects from the database
sub fetch {
  my $self = shift;
  my ($class,$pattern,$count,$offset,$query,$filled,$total,$filltag) =  
    rearrange(['CLASS',['NAME','PATTERN'],'COUNT','OFFSET','QUERY',
	       ['FILL','FILLED'],'TOTAL','FILLTAG'],@_);

Ace.pm  view on Meta::CPAN

  }

  return wantarray ? @h : $h[0];
}

sub cache    { 
  my $self = shift;
  my $d    = $self->{filecache};
  $self->{filecache} = shift if @_;
  $d;
}

sub _create_cache {
  my $self   = shift;
  my $params = shift;
  $params    = {} if $params and !ref $params;

  return unless eval {require Cache::SizeAwareFileCache};  # not installed

Ace.pm  view on Meta::CPAN

  my $cache_obj = Cache::SizeAwareFileCache->new(\%cache_params);
  $self->cache($cache_obj);
}

# class method
sub name2db {
  shift;
  my $name = shift;
  return unless defined $name;
  my $d = $NAME2DB{$name};
  # weaken($NAME2DB{$name} = shift) if @_;
  $NAME2DB{$name} = shift if @_;
  $d;
}

# make a new object using indicated class and name pattern
sub new {
  my $self = shift;
  my ($class,$pattern) = rearrange([['CLASS'],['NAME','PATTERN']],@_);
  croak "You must provide -class and -pattern arguments" 
    unless $class && $pattern;
  # escape % signs in the string

Ace.pm  view on Meta::CPAN

  }
  $self->fetch($1 => $2);
}

# perform an AQL query
sub aql {
  my $self = shift;
  my $query = shift;
  my $db = $self->db;
  my $r = $self->raw_query("aql -j $query");
  if ($r =~ /(AQL error.*)/) {

Ace.pm  view on Meta::CPAN

  return @r;
}

# Return the contents of a keyset.  Pattern matches are allowed, in which case
# the keysets will be merged.
sub keyset {
  my $self = shift;
  my $pattern = shift;
  $self->raw_query (qq{find keyset "$pattern"});
  $self->raw_query (qq{follow});
  return $self->_list;

Ace.pm  view on Meta::CPAN



#########################################################
# These functions are for low-level (non OO) access only.
# This is for low-level access only.
sub show {
    my ($self,$class,$pattern,$tag) = @_;
    $Ace::Error = '';
    return unless $self->count($class,$pattern);

    # if we get here, then we've got some data to return.

Ace.pm  view on Meta::CPAN

	return;
    }
    return grep (!m!^//!,split("\n\n",$result));
}

sub read_object {
    my $self = shift;
    return unless $self->{database};
    my $result;
    while ($self->{database}->status == STATUS_PENDING()) {
      my $data = $self->{database}->read();

Ace.pm  view on Meta::CPAN

    }
    return $result;
}

# do a query, and return the result immediately
sub raw_query {
  my ($self,$query,$no_alert,$parse) = @_;
  $self->_alert_iterators unless $no_alert;
  $self->{database}->query($query, $parse ? ACE_PARSE : () );
  return $self->read_object;
}

# return the last error
sub error {
  my $class = shift;
  $Ace::Error = shift() if defined($_[0]);
  $Ace::Error=~s/\0//g;  # get rid of nulls
  return $Ace::Error;
}

# close the database
sub close {
  my $self = shift;
  $self->raw_query('save') if $self->auto_save;
  foreach (keys %{$self->{iterators}}) {
    $self->_unregister_iterator($_);
  }
  delete $self->{database};
}

sub DESTROY { 
  my $self = shift;
  return if caller() =~ /^Cache\:\:/;
  warn "$self->DESTROY at ", join ' ',caller() if Ace->debug;
  $self->close;
}


#####################################################################
###################### private routines #############################
sub rearrange {
    my($order,@param) = @_;
    return unless @param;
    my %param;

    if (ref $param[0] eq 'HASH') {

Ace.pm  view on Meta::CPAN

    push (@return_array,\%param) if %param;
    return @return_array;
}

# do a query, but don't return the result
sub _query {
  my ($self,@query) = @_;
  $self->_alert_iterators;
  $self->{'database'}->query("@query");
}

# return a portion of the active list
sub _list {
  my $self = shift;
  my ($count,$offset) = @_;
  my (@result);
  my $query = 'list -j';
  $query .= " -b $offset" if defined $offset;

Ace.pm  view on Meta::CPAN

  }
  return @result;
}

# return a portion of the active list
sub _fetch {
  my $self = shift;
  my ($count,$start,$tag) = @_;
  my (@result);
  $tag = '' unless defined $tag;
  my $query = "show -j $tag";

Ace.pm  view on Meta::CPAN

    }
  }
  return wantarray ? @result : $result[0];
}

sub _fetch_chunk {
  my $self = shift;
  return unless $self->{database}->status == STATUS_PENDING();
  my $result = $self->{database}->read();
  $result =~ s/\0//g;  # get rid of &$#&@!! nulls
  my @chunks = split("\n\n",$result);

Ace.pm  view on Meta::CPAN

    push(@result,$self->class_for($class,$id)->newFromText($_,$self));
  }
  return @result;
}

sub _alert_iterators {
  my $self = shift;
  foreach (keys %{$self->{iterators}}) {
    $self->{iterators}{$_}->invalidate if $self->{iterators}{$_};
  }
  undef $self->{active_list};
}

sub asString {
  my $self = shift;
  return "tace://$self->{path}" if $self->{'path'};
  my $server = $self->db && $self->db->isa('Ace::SocketServer') ? 'sace' : 'rpcace';
  return "$server://$self->{host}:$self->{port}" if $self->{'host'};
  return ref $self;
}

sub cmp {
  my ($self,$arg,$reversed) = @_;
  my $cmp;
  if (ref($arg) and $arg->isa('Ace')) {
    $cmp = $self->asString cmp $arg->asString;
  } else {

Ace.pm  view on Meta::CPAN

  return $reversed ? -$cmp : $cmp;
}


# Count the objects matching pattern without fetching them.
sub count {
  my $self = shift;
  my ($class,$pattern,$query) = rearrange(['CLASS',
					   ['NAME','PATTERN'],
					   'QUERY'],@_);
  $Ace::Error = '';

Ace.pm  view on Meta::CPAN


=cut

# -------------------- AUTOLOADED SUBS ------------------

sub debug {
  my $package = shift;
  my $d = $DEBUG_LEVEL;
  $DEBUG_LEVEL = shift if @_;
  $d;
}

Ace.pm  view on Meta::CPAN

# Return true if the database is still connected.  This is oddly convoluted
# because there are numerous things that can go wrong, including:
#   1. server has gone away
#   2. server has timed out our connection! (grrrrr)
#   3. communications channel contains unread garbage and is in an inconsistent state
sub ping {
  my $self = shift;
  local($SIG{PIPE})='IGNORE';  # so we don't get a fatal exception during the check
  my $result = $self->raw_query('');
  return unless $result;  # server has gone away
  return if $result=~/broken connection|client time out/;  # server has timed us out  
  return unless $self->{database}->status() == STATUS_WAITING(); #communications oddness
  return 1;
}

# Get or set the display style for dates
sub date_style {
  my $self = shift;
  $self->{'date_style'} = $_[0] if defined $_[0];
  return $self->{'date_style'};
}

# Get or set whether we retrieve timestamps
sub timestamps {
  my $self = shift;
  $self->{'timestamps'} = $_[0] if defined $_[0];
  return $self->{'timestamps'};
}

# Add one or more objects to the database
sub put {
  my $self = shift;
  my @objects = @_;
  my $count = 0;
  $Ace::Error = '';
  foreach my $object (@objects) {

Ace.pm  view on Meta::CPAN

  }
  return $count;
}

# Parse a single object and return the result as an object
sub parse {
  my $self = shift;
  my $ace_data = shift;
  my @lines = split("\n",$ace_data);
  foreach (@lines) { s/;/\\;/;  } # protect semicolons  
  my $query = join("; ",@lines);

Ace.pm  view on Meta::CPAN

  return $results[0];
}

# Parse a single object as longtext and return the result
# as an object
sub parse_longtext {
  my $self  = shift;
  my ($title,$body) = @_;
      my $mm = "parse =
Longtext $title
$body

Ace.pm  view on Meta::CPAN

  return $results[0];
}


# Parse a file and return all the results
sub parse_file {
  my $self = shift;
  my ($file,$keepgoing) = @_;
  local(*ACE);
  local($/) = '';  # paragraph mode
  my(@objects,$errors);

Ace.pm  view on Meta::CPAN

  return @objects;
}

# Create a new Ace::Object in the indicated database
# (doesn't actually write into database until you do a commit)
sub new {
  my $self = shift;
  my ($class,$name) = rearrange([qw/CLASS NAME/],@_);
  return if $self->fetch($class,$name);
  my $obj = $self->class_for($class,$name)->new($class,$name,$self);
  return $obj;
}

# Return the layout, which contains classes that should be displayed
sub layout {
  my $self = shift;
  my $result = $self->raw_query('layout');
  $result=~s{\n(\s*\n|//.*\n|\0)+\Z}{}m;  # get rid of extraneous information
  $result;
}

# Return a hash of all the classes and the number of objects in each
sub class_count {
  my $self = shift;
  return $self->raw_query('classes') =~ /^\s+(\S+) (\d+)/gm;
}

# Return a hash of miscellaneous status information from the server
# (to be expanded later)
sub status {
  my $self = shift;
  my $data = $self->raw_query('status');
  study $data;

  my %status;

Ace.pm  view on Meta::CPAN

		      memory  => $memory * 1024,
		      };
  return wantarray ? %status : \%status;
}

sub title {
  my $self = shift;
  my $status= $self->status;
  $status->{database}{title};
}

sub version {
  my $self = shift;
  my $status= $self->status;
  $status->{database}{version};
}

sub auto_save {
  my $self = shift;
  if ($self->db && $self->db->can('auto_save')) {
    $self->db->auto_save;
  } else {
    $self->{'auto_save'} = $_[0] if defined $_[0];
    return $self->{'auto_save'};
  }
}

# Perform an ace query and return the result
sub find {
  my $self = shift;
  my ($query,$count,$offset,$filled,$total) = rearrange(['QUERY','COUNT',
							 'OFFSET',['FILL','FILLED'],'TOTAL'],@_);
  $offset += 0;
  $query = "find $query" unless $query=~/^find/i;

Ace.pm  view on Meta::CPAN

}

#########################################################
# Grep function returns count in a scalar context, list
# of retrieved objects in a list context.
sub grep {
  my $self = shift;
  my ($pattern,$count,$offset,$filled,$filltag,$total,$long) = 
      rearrange(['PATTERN','COUNT','OFFSET',['FILL','FILLED'],'FILLTAG','TOTAL','LONG'],@_);
  $offset += 0;
  my $grep = defined($long) && $long ? 'LongGrep' : 'grep';

Ace.pm  view on Meta::CPAN

    @h = $filled ? $self->_fetch($count,$offset) : $self->_list($count,$offset);
  }
  @h;
}

sub pick {
    my ($self,$class,$item) = @_;
    $Ace::Error = '';
    # assumption of uniqueness of name is violated by some classes!
    #    return () unless $self->count($class,$item) == 1;
    return unless $self->count($class,$item) >= 1;

Ace.pm  view on Meta::CPAN

    return $result[0];
}


# these two only get loaded if the Ace::Freesubs .XS isn't compiled
sub freeprotect {
  my $class = shift;
  my $text = shift;
  $text =~ s/\n/\\n/g;
  $text =~ s/\t/\\t/g;
  $text =~ s/"/\\"/g;
  return qq("$text");
}

sub split {
  my $class = shift;
  my $text = shift;
  $text =~ s/\\n/\n/g;
  $text =~ s/\\t/\t/g;
  my ($id,$ts);

Ace.pm  view on Meta::CPAN

  return ($class,$id) unless $ts;
  return ($class,$id,$ts);  # return timestamp
}

# Return a list of all the classes known to the server.
sub classes {
  my ($self,$invisible) = @_;
  my $query = defined($invisible) && $invisible ?
    "query find class !buried" 
      :
    "query find class visible AND !buried";

Ace.pm  view on Meta::CPAN

  return $self->_list;
}

################## iterators ##################
# Fetch many objects in iterative style
sub fetch_many {
  my $self = shift;
  my ($class,$pattern,$filled,$query,$chunksize) = rearrange( ['CLASS',
							       ['PATTERN','NAME'],
							       ['FILL','FILLED'],
							       'QUERY',

Ace.pm  view on Meta::CPAN

  }
  my $iterator = Ace::Iterator->new($self,$query,$filled,$chunksize);
  return $iterator;
}

sub _register_iterator {
  my ($self,$iterator) = @_;
  $self->{iterators}{$iterator} = $iterator;
}

sub _unregister_iterator {
  my ($self,$iterator) = @_;
  $self->_restore_iterator($iterator);
  delete $self->{iterators}{$iterator};
}

sub _save_iterator {
  my $self = shift;
  my $iterator = shift;
  return unless $self->{iterators}{$iterator};
  $self->{iterator_stack} ||= [];
  return 1 if grep { $_ eq $iterator } @{$self->{iterator_stack}};

Ace.pm  view on Meta::CPAN

  1;  # result code -- CHANGE THIS LATER
}

# horrid method that keeps the database's view of
# iterators in synch with our view
sub _restore_iterator {
  my $self = shift;
  my $iterator = shift;

  # no such iterator known, return false
  return unless $self->{iterators}{$iterator};

Ace.pm  view on Meta::CPAN


  splice(@$list,$i,1);   # remove from position
  return 1;
}

sub datetime {
  my $self = shift;
  my $time = shift || time;
  my ($sec,$min,$hour,$day,$mon,$year) = localtime($time);
  $year += 1900;   # avoid Y3K bug
  sprintf("%4d-%02d-%02d %02d:%02d:%02d",$year,$mon+1,$day,$hour,$min,$sec);
}

sub date {
  my $self = shift;
  my $time = shift || time;
  my ($sec,$min,$hour,$day,$mon,$year) = localtime($time);
  $year += 1900;   # avoid Y3K bug
  sprintf("%4d-%02d-%02d",$year,$mon+1,$day);

 view all matches for this distribution


Acme-123

 view release on metacpan or  search on metacpan

lib/Acme/123.pm  view on Meta::CPAN

	'sp' => [qw /uno dos tres cuatro cinco seis siete ocho nueve diez/],
	'it' => [qw /uno due tre quattro cinque sei sette otto nove dieci/]
);
my @numbers = @{$languages {en}};

sub printnumbers {
	foreach (@numbers) {
		print "$_ \n";
	}
}

sub setLanguage {
	my $self = shift;
	my $language = shift;
	@numbers = @{$languages {$language}};
}

sub getnumbers {
	return @numbers;
}

sub new
{
    my ($class, %parameters) = @_;

    my $self = bless ({}, ref ($class) || $class);

 view all matches for this distribution


Acme-1337

 view release on metacpan or  search on metacpan

lib/Acme/L337.pm  view on Meta::CPAN

package L337;

use strict;

sub translate($string) {
   # Common leet
   my $tempstring;
   $tempstring =~ "tr/[i,I]/!";
   $tempstring =~ "tr/[t,T]/7";
   $tempstring =~ "tr/[e,E]/3";

 view all matches for this distribution


Acme-24

 view release on metacpan or  search on metacpan

lib/Acme/24.pm  view on Meta::CPAN

use XML::RSSLite ();

use constant URL => 'http://www.notrly.com/jackbauer';

# Returns one random fact
sub random_jackbauer_fact
{
    my $url  = URL;
    my $page = LWP::Simple::get($url);
    my $fact = '';

lib/Acme/24.pm  view on Meta::CPAN

    return($fact);

}

# Returns an array of 24 random facts
sub random_jackbauer_facts
{
    my @facts = ();
    my $url = URL . '/rss.php';
    my $tries = 5;
    my %seen;

lib/Acme/24.pm  view on Meta::CPAN


    return(\@facts);
}

# Build a database of Jack Bauer facts
sub collect_facts
{
    my($self, $file) = @_;
    $file ||= './jackbauer.txt';
    my $new_facts = $self->random_jackbauer_facts();
    return unless $new_facts;

 view all matches for this distribution


Acme-2zicon

 view release on metacpan or  search on metacpan

lib/Acme/2zicon.pm  view on Meta::CPAN

    TsurumiMoe
    OtsukaMiyu
    YamatoAo
);

sub new {
    my $class = shift;
    my $self  = bless {members => []}, $class;

    $self->_initialize;

    return $self;
}

sub members {
    my ($self, $type, @members) = @_;
    @members = @{$self->{members}} unless @members;

    return @members unless $type;
}

sub sort {
    my ($self, $type, $order, @members) = @_;
    @members = $self->members unless @members;

    # order by desc if $order is true
    if ($order) {

lib/Acme/2zicon.pm  view on Meta::CPAN

    else {
        return sort {$a->$type <=> $b->$type} @members;
    }
}

sub select {
    my ($self, $type, $number, $operator, @members) = @_;

    $self->_die('invalid operator was passed in')
        unless grep {$operator eq $_} qw(== >= <= > <);

    @members = $self->members unless @members;
    my $compare = eval "(sub { \$number $operator \$_[0] })";

    return grep { $compare->($_->$type) } @members;
}

sub _initialize {
    my $self = shift;

    for my $member (@members) {
        my $module_name = 'Acme::2zicon::'.$member;

lib/Acme/2zicon.pm  view on Meta::CPAN

    }

    return 1;
}

sub _die {
    my ($self, $message) = @_;
    Carp::croak($message);
}

1;

 view all matches for this distribution


Acme-3mxA

 view release on metacpan or  search on metacpan

lib/Acme/3mxA.pm  view on Meta::CPAN

use utf8;
package Acme::3mxA;

sub import {
  Acme::ǝmɔA->import;
}

"með blóðnasir"

 view all matches for this distribution


Acme-6502

 view release on metacpan or  search on metacpan

inc/MyBuilder.pm  view on Meta::CPAN

package MyBuilder;

use base qw( Module::Build );

sub create_build_script {
  my ( $self, @args ) = @_;
  $self->_auto_mm;
  return $self->SUPER::create_build_script( @args );
}

sub _auto_mm {
  my $self = shift;
  my $mm   = $self->meta_merge;
  my @meta = qw( homepage bugtracker MailingList repository );
  for my $meta ( @meta ) {
    next if exists $mm->{resources}{$meta};

inc/MyBuilder.pm  view on Meta::CPAN

    $mm->{resources}{$meta} = $av if defined $av;
  }
  $self->meta_merge( $mm );
}

sub _auto_repository {
  my $self = shift;
  if ( -d '.svn' ) {
    my $info = `svn info .`;
    return $1 if $info =~ /^URL:\s+(.+)$/m;
  }

inc/MyBuilder.pm  view on Meta::CPAN

    return $url;
  }
  return;
}

sub _auto_bugtracker {
  'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name;
}

sub ACTION_testauthor {
  my $self = shift;
  $self->test_files( 'xt/author' );
  $self->ACTION_test;
}

sub ACTION_critic {
  exec qw( perlcritic -1 -q -profile perlcriticrc lib/ ), glob 't/*.t';
}

sub ACTION_tags {
  exec(
    qw(
     ctags -f tags --recurse --totals
     --exclude=blib
     --exclude=.svn

inc/MyBuilder.pm  view on Meta::CPAN

     t/ lib/
     )
  );
}

sub ACTION_tidy {
  my $self = shift;

  my @extra = qw( Build.PL );

  my %found_files = map { %$_ } $self->find_pm_files,

 view all matches for this distribution


Acme-ADEAS-Utils

 view release on metacpan or  search on metacpan

lib/Acme/ADEAS/Utils.pm  view on Meta::CPAN

    Accepts a list, returns the sum of the numbers provided. Anything
    that isn't a number will be treated as zero.

=cut

sub sum {

  my $sum = 0;

  foreach my $element ( @_ ) {
    # I could get a module to do this check, but I don't want to

 view all matches for this distribution


( run in 1.352 second using v1.01-cache-2.11-cpan-a5abf4f5562 )