AWS-Lambda

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-38-runtime-al2023-x86_64:1
    say $info->{runtime_version}; # 1
    say $info->{paws_arn}         # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-38-paws-al2023-x86_64:1
    say $info->{paws_version}     # 1,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::print_runtime_arn_al2023("5.38", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::print_paws_arn_al2023("5.38", "us-east-1")'

The list of all layer ARNs is available on [AWS::Lambda::AL2023](https://metacpan.org/pod/AWS%3A%3ALambda%3A%3AAL2023).

## Use Pre-built Zip Archives

1. Login to your AWS Account and go to the Lambda Console.
2. Create a new layer and give it a name.
3. For the "Code entry type" selection, select **Upload a file from Amazon S3**.
4. In the "License" section, input [https://github.com/shogo82148/p5-aws-lambda/blob/main/LICENSE](https://github.com/shogo82148/p5-aws-lambda/blob/main/LICENSE).
5. Click **Create** button.

README.md  view on Meta::CPAN

        --role arn:aws:iam::xxxxxxxxxxxx:role/service-role/lambda-custom-runtime-perl-role \
        --layers \
            "arn:aws:lambda:$REGION:445285296882:layer:perl-5-38-runtime-al2023-x86_64:5" \
            "arn:aws:lambda:$REGION:445285296882:layer:perl-5-38-paws-al2023-x86_64:4"

Now, you can use [Paws](https://metacpan.org/pod/Paws) to call AWS API from your Lambda function.

    use Paws;
    my $obj = Paws->service('...');
    my $res = $obj->MethodCall(Arg1 => $val1, Arg2 => $val2);
    print $res->AttributeFromResult;

The list of all layer ARNs is available on [AWS::Lambda::AL2023](https://metacpan.org/pod/AWS%3A%3ALambda%3A%3AAL2023).

URLs for Zip archive are:

`https://shogo82148-lambda-perl-runtime-$REGION.s3.amazonaws.com/perl-$VERSION-paws-al2-$ARCHITECTURE.zip`

## Use Prebuilt Docker Images for Paws

use the `base-$VERSION-paws.al2023` tag on [https://gallery.ecr.aws/shogo82148/p5-aws-lambda](https://gallery.ecr.aws/shogo82148/p5-aws-lambda) or [https://hub.docker.com/r/shogo82148/p5-aws-lambda](https://hub.docker.com/r/shogo82148/p5-aws-lambda).

author/build-paws-layer-al2.sh  view on Meta::CPAN

esac

docker run \
    -v "$ROOT:/var/task" \
    -v "$OPT-$PLATFORM/lib/perl5/site_perl:/opt/lib/perl5/site_perl" \
    -v "$OPT-$PLATFORM/lib:/opt-lib" \
    --platform "$DOCKER_PLATFORM" \
    "public.ecr.aws/sam/build-provided.al2:1-$PLATFORM" \
    ./author/build-paws-al2.sh "$TAG"

find "$OPT-$PLATFORM" -type f -a -name '*.pm' -print0 | parallel -0 -j 32 "$ROOT/author/perlstrip.sh"

cd "$OPT-$PLATFORM"
mkdir -p "$DIST"
zip -9 -r "$DIST/perl-$TAG-paws-al2-$PLATFORM.zip" .

author/build-paws-layer-al2023.sh  view on Meta::CPAN

esac

docker run \
    -v "$ROOT:/var/task" \
    -v "$OPT-$PLATFORM/lib/perl5/site_perl:/opt/lib/perl5/site_perl" \
    -v "$OPT-$PLATFORM/lib:/opt-lib" \
    --platform "$DOCKER_PLATFORM" \
    "public.ecr.aws/sam/build-provided.al2023:1-$PLATFORM" \
    ./author/build-paws-al2023.sh "$TAG"

find "$OPT-$PLATFORM" -type f -a -name '*.pm' -print0 | parallel -0 -j 32 "$ROOT/author/perlstrip.sh"

cd "$OPT-$PLATFORM"
mkdir -p "$DIST"
zip -9 -r "$DIST/perl-$TAG-paws-al2023-$PLATFORM.zip" .

author/pod-stripper/scripts/pod_stripper.pl  view on Meta::CPAN

  @dirs = @ARGV;
} else {
  @dirs = ('local/');
}

# Traverse desired filesystems
File::Find::find({wanted => \&wanted}, @dirs);

say "Original module size: $original_bytes";
say "Stripped to: $final_bytes";
say sprintf "Won %0.02f%%", (1- ($final_bytes / $original_bytes)) * 100;

exit;

sub wanted {
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size);

    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size) = lstat($_);
    $original_bytes += $size;

    if (-f $_ && /^.*\.pm\z/s) {

author/update-aws-lambda-al.pl  view on Meta::CPAN

chomp(my $module_version = `cat $FindBin::Bin/../META.json | jq -r .version`);
my $latest_perl = $versions->[0];
my $latest_perl_layer = $latest_perl =~ s/[.]/-/r;
my $latest_runtime_arn = $layers->{$latest_perl}{'us-east-1'}{runtime_arn};
my $latest_runtime_version = $layers->{$latest_perl}{'us-east-1'}{runtime_version};
my $latest_paws_arn = $layers->{$latest_perl}{'us-east-1'}{paws_arn};
my $latest_paws_version = $layers->{$latest_perl}{'us-east-1'}{paws_version};

open my $fh, '>', "$FindBin::Bin/../lib/AWS/Lambda/AL.pm" or die "$!";

sub printfh :prototype($) {
    my $contents = shift;
    $contents =~ s/\@\@VERSION\@\@/$module_version/g;
    $contents =~ s/\@\@LATEST_PERL\@\@/$latest_perl/g;
    $contents =~ s/\@\@LATEST_PERL_LAYER\@\@/$latest_perl_layer/g;
    $contents =~ s/\@\@LATEST_RUNTIME_ARN\@\@/$latest_runtime_arn/g;
    $contents =~ s/\@\@LATEST_RUNTIME_VERSION\@\@/$latest_runtime_version/g;
    $contents =~ s/\@\@LATEST_PAWS_ARN\@\@/$latest_paws_arn/g;
    $contents =~ s/\@\@LATEST_PAWS_VERSION\@\@/$latest_paws_version/g;
    print $fh $contents;
}

printfh(<<'EOS');
package AWS::Lambda::AL;
use 5.026000;
use strict;
use warnings;

our $VERSION = "@@VERSION@@";

EOS

print $fh "# This list is auto generated by authors/update-aws-lambda-al.pl; DO NOT EDIT\n";
print $fh "our \$LAYERS = {\n";
for my $version (@$versions) {
    print $fh "    '$version' => {\n";
    for my $region (@{$regions->{x86_64}}) {
        next unless $layers->{$version}{$region}{runtime_arn};
        print $fh <<EOS
        '$region' => {
            runtime_arn     => "$layers->{$version}{$region}{runtime_arn}",
            runtime_version => $layers->{$version}{$region}{runtime_version},
            paws_arn        => "$layers->{$version}{$region}{paws_arn}",
            paws_version    => $layers->{$version}{$region}{paws_version},
        },
EOS
    }
    print $fh "    },\n";
}
print $fh "};\n\n";

printfh(<<'EOS');

sub get_layer_info {
    my ($version, $region) = @_;
    return $LAYERS->{$version}{$region};
}

sub print_runtime_arn {
    my ($version, $region) = @_;
    print $LAYERS->{$version}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region) = @_;
    print $LAYERS->{$version}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda::AL - AWS Lambda Custom Runtimes based on Amazon Linux

author/update-aws-lambda-al.pl  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # @@LATEST_RUNTIME_ARN@@
    say $info->{runtime_version}; # @@LATEST_RUNTIME_VERSION@@
    say $info->{paws_arn}         # @@LATEST_PAWS_ARN@@
    say $info->{paws_version}     # @@LATEST_PAWS_VERSION@@,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::AL::print_runtime_arn("@@LATEST_PERL@@", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::AL::print_paws_arn("@@LATEST_PERL@@", "us-east-1")'

The list of all available layer ARN is:

=over

EOS

for my $version (@$versions) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $region (@{$regions->{x86_64}}) {
        next unless $layers->{$version}{$region}{runtime_arn};
        print $fh "=item C<$layers->{$version}{$region}{runtime_arn}>\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

And Paws layers:

=over

EOS

for my $version (@$versions) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $region (@{$regions->{x86_64}}) {
        next unless $layers->{$version}{$region}{paws_arn};
        print $fh "=item C<$layers->{$version}{$region}{paws_arn}>\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

=head2 Pre-built Zip Archives for Amazon Linux

URLs of zip archives are:

C<https://shogo82148-lambda-perl-runtime-$REGION.s3.amazonaws.com/perl-$VERSION-runtime.zip>

And Paws:

author/update-aws-lambda-al2.pl  view on Meta::CPAN

chomp(my $module_version = `cat $FindBin::Bin/../META.json | jq -r .version`);
my $latest_perl = $versions_al2->[0];
my $latest_perl_layer = $latest_perl =~ s/[.]/-/r;
my $latest_runtime_arn = $layers_al2->{$latest_perl}{'us-east-1'}{x86_64}{runtime_arn};
my $latest_runtime_version = $layers_al2->{$latest_perl}{'us-east-1'}{x86_64}{runtime_version};
my $latest_paws_arn = $layers_al2->{$latest_perl}{'us-east-1'}{x86_64}{paws_arn};
my $latest_paws_version = $layers_al2->{$latest_perl}{'us-east-1'}{x86_64}{paws_version};

open my $fh, '>', "$FindBin::Bin/../lib/AWS/Lambda/AL2.pm" or die "$!";

sub printfh :prototype($) {
    my $contents = shift;
    $contents =~ s/\@\@VERSION\@\@/$module_version/g;
    $contents =~ s/\@\@LATEST_PERL\@\@/$latest_perl/g;
    $contents =~ s/\@\@LATEST_PERL_LAYER\@\@/$latest_perl_layer/g;
    $contents =~ s/\@\@LATEST_RUNTIME_ARN\@\@/$latest_runtime_arn/g;
    $contents =~ s/\@\@LATEST_RUNTIME_VERSION\@\@/$latest_runtime_version/g;
    $contents =~ s/\@\@LATEST_PAWS_ARN\@\@/$latest_paws_arn/g;
    $contents =~ s/\@\@LATEST_PAWS_VERSION\@\@/$latest_paws_version/g;
    print $fh $contents;
}

printfh(<<'EOS');
package AWS::Lambda::AL2;
use 5.026000;
use strict;
use warnings;

our $VERSION = "@@VERSION@@";

EOS

print $fh "# This list is auto generated by authors/update-aws-lambda-al2.pl; DO NOT EDIT\n";
print $fh "our \$LAYERS = {\n";
for my $version (@$versions_al2) {
    print $fh "    '$version' => {\n";
    for my $arch (@$archs) {
        print $fh "        '$arch' => {\n";
        for my $region (@{$regions->{$arch}}) {
            next unless $layers_al2->{$version}{$region}{$arch}{runtime_arn};
            print $fh <<EOS
            '$region' => {
                runtime_arn     => "$layers_al2->{$version}{$region}{$arch}{runtime_arn}",
                runtime_version => $layers_al2->{$version}{$region}{$arch}{runtime_version},
                paws_arn        => "$layers_al2->{$version}{$region}{$arch}{paws_arn}",
                paws_version    => $layers_al2->{$version}{$region}{$arch}{paws_version},
            },
EOS
        }
        print $fh "        },\n";
    }
    print $fh "    },\n";
}
print $fh "};\n\n";

printfh(<<'EOS');

sub get_layer_info {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    return $LAYERS->{$version}{$arch}{$region};
}

sub print_runtime_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda::AL2 - AWS Lambda Custom Runtimes based on Amazon Linux 2

author/update-aws-lambda-al2.pl  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # @@LATEST_RUNTIME_ARN@@
    say $info->{runtime_version}; # @@LATEST_RUNTIME_VERSION@@
    say $info->{paws_arn}         # @@LATEST_PAWS_ARN@@
    say $info->{paws_version}     # @@LATEST_PAWS_VERSION@@,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::print_runtime_arn("@@LATEST_PERL@@", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::print_paws_arn("@@LATEST_PERL@@", "us-east-1")'

The list of all available layer ARN is here:

=over

EOS

for my $version (@$versions_al2) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $arch(@$archs) {
        print $fh "=item $arch architecture\n\n=over\n\n";
        for my $region (@{$regions->{$arch}}) {
            next unless $layers_al2->{$version}{$region}{$arch}{runtime_arn};
            print $fh "=item C<$layers_al2->{$version}{$region}{$arch}{runtime_arn}>\n\n";
        }
        print $fh "=back\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

And Paws layers:

=over

EOS

for my $version (@$versions_al2) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $arch(@$archs) {
        print $fh "=item $arch architecture\n\n=over\n\n";
        for my $region (@{$regions->{$arch}}) {
            next unless $layers_al2->{$version}{$region}{$arch}{paws_arn};
            print $fh "=item C<$layers_al2->{$version}{$region}{$arch}{paws_arn}>\n\n";
        }
        print $fh "=back\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

=head2 Use Pre-built Zip Archives

URLs for Zip archives are:

C<https://shogo82148-lambda-perl-runtime-$REGION.s3.amazonaws.com/perl-$VERSION-runtime-al2-$ARCHITECTURE.zip>

And Paws:

author/update-aws-lambda-al2.pl  view on Meta::CPAN


=head2 Pre-built Legacy Public Lambda Layers for Amazon Linux 2

The list of all available layer ARN is:

=over

EOS

for my $version (@$versions_al2) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $region (@{$regions->{x86_64}}) {
        next unless $layers_al2_x86_64->{$version}{$region}{runtime_arn};
        print $fh "=item C<$layers_al2_x86_64->{$version}{$region}{runtime_arn}>\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

And Paws layers:

=over

EOS

for my $version (@$versions_al2) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $region (@{$regions->{x86_64}}) {
        next unless $layers_al2_x86_64->{$version}{$region}{paws_arn};
        print $fh "=item C<$layers_al2_x86_64->{$version}{$region}{paws_arn}>\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

=head2 Pre-built Legacy Zip Archives for Amazon Linux 2 x86_64

URLs of zip archives are here:

C<https://shogo82148-lambda-perl-runtime-$REGION.s3.amazonaws.com/perl-$VERSION-runtime-al2.zip>

And Paws:

author/update-aws-lambda-al2023.pl  view on Meta::CPAN

chomp(my $module_version = `cat $FindBin::Bin/../META.json | jq -r .version`);
my $latest_perl = $versions_al2023->[0];
my $latest_perl_layer = $latest_perl =~ s/[.]/-/r;
my $latest_runtime_arn = $layers_al2023->{$latest_perl}{'us-east-1'}{x86_64}{runtime_arn};
my $latest_runtime_version = $layers_al2023->{$latest_perl}{'us-east-1'}{x86_64}{runtime_version};
my $latest_paws_arn = $layers_al2023->{$latest_perl}{'us-east-1'}{x86_64}{paws_arn};
my $latest_paws_version = $layers_al2023->{$latest_perl}{'us-east-1'}{x86_64}{paws_version};

open my $fh, '>', "$FindBin::Bin/../lib/AWS/Lambda/AL2023.pm" or die "$!";

sub printfh :prototype($) {
    my $contents = shift;
    $contents =~ s/\@\@VERSION\@\@/$module_version/g;
    $contents =~ s/\@\@LATEST_PERL\@\@/$latest_perl/g;
    $contents =~ s/\@\@LATEST_PERL_LAYER\@\@/$latest_perl_layer/g;
    $contents =~ s/\@\@LATEST_RUNTIME_ARN\@\@/$latest_runtime_arn/g;
    $contents =~ s/\@\@LATEST_RUNTIME_VERSION\@\@/$latest_runtime_version/g;
    $contents =~ s/\@\@LATEST_PAWS_ARN\@\@/$latest_paws_arn/g;
    $contents =~ s/\@\@LATEST_PAWS_VERSION\@\@/$latest_paws_version/g;
    print $fh $contents;
}

printfh(<<'EOS');
package AWS::Lambda::AL2023;
use 5.026000;
use strict;
use warnings;

our $VERSION = "@@VERSION@@";

EOS

print $fh "# This list is auto generated by authors/update-aws-lambda-al2023.pl; DO NOT EDIT\n";
print $fh "our \$LAYERS = {\n";
for my $version (@$versions_al2023) {
    print $fh "    '$version' => {\n";
    for my $arch (@$archs) {
        print $fh "        '$arch' => {\n";
        for my $region (@{$regions->{$arch}}) {
            next unless $layers_al2023->{$version}{$region}{$arch}{runtime_arn};
            print $fh <<EOS
            '$region' => {
                runtime_arn     => "$layers_al2023->{$version}{$region}{$arch}{runtime_arn}",
                runtime_version => $layers_al2023->{$version}{$region}{$arch}{runtime_version},
                paws_arn        => "$layers_al2023->{$version}{$region}{$arch}{paws_arn}",
                paws_version    => $layers_al2023->{$version}{$region}{$arch}{paws_version},
            },
EOS
        }
        print $fh "        },\n";
    }
    print $fh "    },\n";
}
print $fh "};\n\n";

printfh(<<'EOS');

sub get_layer_info {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    return $LAYERS->{$version}{$arch}{$region};
}

sub print_runtime_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda::AL2023 - AWS Lambda Custom Runtimes based on Amazon Linux 2023

author/update-aws-lambda-al2023.pl  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # @@LATEST_RUNTIME_ARN@@
    say $info->{runtime_version}; # @@LATEST_RUNTIME_VERSION@@
    say $info->{paws_arn}         # @@LATEST_PAWS_ARN@@
    say $info->{paws_version}     # @@LATEST_PAWS_VERSION@@,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::print_runtime_arn("@@LATEST_PERL@@", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::print_paws_arn("@@LATEST_PERL@@", "us-east-1")'

The list of all available layer ARN is here:

=over

EOS

for my $version (@$versions_al2023) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $arch(@$archs) {
        print $fh "=item $arch architecture\n\n=over\n\n";
        for my $region (@{$regions->{$arch}}) {
            next unless $layers_al2023->{$version}{$region}{$arch}{runtime_arn};
            print $fh "=item C<$layers_al2023->{$version}{$region}{$arch}{runtime_arn}>\n\n";
        }
        print $fh "=back\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

And Paws layers:

=over

EOS

for my $version (@$versions_al2023) {
    print $fh "=item Perl $version\n\n=over\n\n";
    for my $arch(@$archs) {
        print $fh "=item $arch architecture\n\n=over\n\n";
        for my $region (@{$regions->{$arch}}) {
            next unless $layers_al2023->{$version}{$region}{$arch}{paws_arn};
            print $fh "=item C<$layers_al2023->{$version}{$region}{$arch}{paws_arn}>\n\n";
        }
        print $fh "=back\n\n";
    }
    print $fh "=back\n\n";
}

printfh(<<'EOS');
=back

=head2 Use Pre-built Zip Archives

URLs for Zip archives are:

C<https://shogo82148-lambda-perl-runtime-$REGION.s3.amazonaws.com/perl-$VERSION-runtime-al2023-$ARCHITECTURE.zip>

And Paws:

examples/cgi/WwwCounter/gifcat.pl  view on Meta::CPAN

;# gifcat.pl: GIFファイル連結ライブラリ Ver1.61
;#
;# Copyright (c) 1997,2002 http://tohoho.wakusei.ne.jp/
;#
;# 著作権は放棄しませんが、自由に使用・改造・再配布可能です。
;#
;# 基本的な使い方
;#    require "gifcat.pl";
;#    open(OUT, "> out.gif");
;#    binmode(OUT);    # MS-DOS や Windows の場合に必要です。
;#    print OUT &gifcat'gifcat("xx.gif", "yy.gif", "zz.gif");
;#    close(OUT);
;#
;# デバッグ用(GIFの解析出力)
;#    require "gifcat.pl";
;#    &gifcat'gifprint("xx.gif", "yy.gif", "zz.gif");
;#
;# 制限事項
;#    アニメGIF同士を連結することはできません。
;#    アニメGIF対応のブラウザでなければ、最初の画像しか表示されません。
;#    高さの異なるGIFファイルは連結できません。
;#
;# 最新版入手先
;#    http://tohoho.wakusei.ne.jp/wwwsoft.htm
;#
;# 更新履歴:
;#    1997.05.03 初版。
;#    1997.05.10 スペルミス修正。
;#    1997.05.29 サイズの異なるカラーテーブルに対応。
;#    1997.07.07 エラー発生時にexit()しないように修正。
;#    1998.05.05 Trailerを持たないGIFファイルを連結できないバグを修正。
;#    1998.05.05 横幅が256を超えるGIFの出力ができないバグを修正。
;#    1998.05.05 gifprint()で連結結果を出力しないように修正。
;#    1998.05.10 連結できないGIF画像があるというバグを修正。
;#    1998.08.20 Ver1.50 変数の初期化を行うように修正。
;#    1998.08.20 Ver1.50 透過GIFに対応。
;#    1999.05.30 Ver1.51 動作には関係ないタイプミス修正。
;#    1999.10.11 Ver1.52 コメントの修正
;#    2000.05.21 Ver1.53 幅の異なるGIFの連結に対応
;#    2000.06.04 Ver1.54 perl -wcのwarning対応
;#    2000.06.04 Ver1.55 インタレースGIF部のコードミスを修正。
;#    2000.09.17 Ver1.56 連続呼び出しの際のバグ修正
;#    2000.11.28 Ver1.57 インタレースGIF部のコードミスを修正。
;#    2001.09.14 Ver1.58 gifcatを連続で呼び出す際の不具合修正。
;#    2001.10.04 Ver1.59 同上。
;#    2001.11.25 Ver1.60 gifprintの不具合修正。
;#    2002.06.10 Ver1.61 Netscape 6.*で1桁目が表示されない問題に対応。
;#
;# ====================================================================

package gifcat;

$pflag = 0;					# print flag

;# =====================================================
;# gifcat'gifprint() - print out GIF diagnostics.
;# =====================================================
sub gifprint {
	$pflag = 1;
	&gifcat(@_);
	$pflag = 0;
}

;# =====================================================
;# gifcat'gifcat() - get a concatenated GIF image.
;# =====================================================
sub gifcat {
	@files = @_;

examples/cgi/WwwCounter/gifcat.pl  view on Meta::CPAN

	if ($GlobalColorTableFlag) {
		$globalColorTable[$Gif] = $GlobalColorTable;
		if ($Gif > 0) {
			if ($GlobalColorTable ne $globalColorTable[$Gif - 1]) {
				$useLocalColorTable = 1;
			}
		}
	}

	if ($pflag) {
		printf("=====================================\n");
		printf("GifHeader\n");
		printf("=====================================\n");
		printf("Signature:                     %s\n", $Signature);
		printf("Version:                       %s\n", $Version);
		printf("Logical Screen Width:          %d\n", $LogicalScreenWidth);
		printf("Logical Screen Height:         %d\n", $LogicalScreenHeight);
		printf("Global Color Table Flag:       %d\n", $GlobalColorTableFlag);
		printf("Color Resolution:              %d\n", $ColorResolution);
		printf("Sort Flag:                     %d\n", $SortFlag);
		printf("Size of Global Color Table:    %d * 3\n", $SizeOfGlobalColorTable);
		printf("Background Color Index:        %d\n", $BackgroundColorIndex);
		printf("Pixel Aspect Ratio:            %d\n", $PixelAspectRatio);
		printf("Global Color Table:            \n");
		Dump($GlobalColorTable);
	}
}

;# =====================================
;# Image Block
;# =====================================
sub ImageBlock {
	$ImageSeparator    = ord(substr($buf, $cnt, 1)); $cnt++;
	$ImageLeftPosition = ord(substr($buf, $cnt, 1))

examples/cgi/WwwCounter/gifcat.pl  view on Meta::CPAN

		$LocalColorTable = substr($buf, $cnt, $SizeOfLocalColorTable);
		$cnt += $SizeOfLocalColorTable * 3;
	} else {
		$SizeOfLocalColorTable = 0;
		$LocalColorTable = "";
	}
	$LzwMinimumCodeSize[$Gif] = ord(substr($buf, $cnt, 1)); $cnt++;
	$ImageData[$Gif] = &DataSubBlock();

	if ($pflag) {
		printf("=====================================\n");
		printf("Image Block\n");
		printf("=====================================\n");
		printf("Image Separator:               0x%02x\n", $ImageSeparator);
		printf("Image Left Position:           %d\n", $ImageLeftPosition);
		printf("Image Top Position:            %d\n", $ImageTopPosition);
		printf("Image Width:                   %d\n", $ImageWidth[$Gif]);
		printf("Image Height:                  %d\n", $ImageHeight);
		printf("Local Color Table Flag:        %d\n", $LocalColorTableFlag);
		printf("Interlace Flag:                %d\n", $InterlaceFlag);
		printf("Sort Flag:                     %d\n", $SortFlag);
		printf("Reserved:                      --\n");
		printf("Size of Local Color Table:     %d\n", $SizeOfLocalColorTable);
		printf("Local Color Table:             \n");
		Dump($LocalColorTable);
		printf("LZW Minimum Code Size:         %d\n", $LzwMinimumCodeSize[$Gif]);
		printf("Image Data:                    \n");
		Dump($ImageData[$Gif]);
		printf("Block Terminator:              0x00\n");
	}
}

;# =====================================
;# Graphic Control Extension
;# =====================================
sub GraphicControlExtension {
	$ExtensionIntroducer   = ord(substr($buf, $cnt, 1)); $cnt++;
	$GraphicControlLabel   = ord(substr($buf, $cnt, 1)); $cnt++;
	$BlockSize             = ord(substr($buf, $cnt, 1)); $cnt++;

examples/cgi/WwwCounter/gifcat.pl  view on Meta::CPAN

	$Reserved              = ($PackedFields23 & 0xe0) >> 5;
	$DisposalMethod        = ($PackedFields23 & 0x1c) >> 5;
	$UserInputFlag         = ($PackedFields23 & 0x02) >> 1;
	$TransparentColorFlag[$Gif]  = $PackedFields23 & 0x01;
	$DelayTime             = ord(substr($buf, $cnt, 1))
			       + ord(substr($buf, $cnt+1, 1)) * 256; $cnt += 2;
	$TransparentColorIndex[$Gif] = ord(substr($buf, $cnt, 1)); $cnt++;
	$BlockTerminator       = ord(substr($buf, $cnt, 1)); $cnt++;

	if ($pflag) {
		printf("=====================================\n");
		printf("Graphic Control Extension\n");
		printf("=====================================\n");
		printf("Extension Introducer:          0x%02x\n", $ExtensionIntroducer);
		printf("Graphic Control Label:         0x%02x\n", $GraphicControlLabel);
		printf("Block Size:                    %d\n", $BlockSize);
		printf("Reserved:                      --\n");
		printf("Disposal Method:               %d\n", $DisposalMethod);
		printf("User Input Flag:               %d\n", $UserInputFlag);
		printf("Transparent Color Flag:        %d\n", $TransparentColorFlag[$Gif]);
		printf("Delay Time:                    %d\n", $DelayTime);
		printf("Transparent Color Index:       %d\n", $TransparentColorIndex[$Gif]);
		printf("Block Terminator:              0x00\n");
	}
}

;# =====================================
;# Comment Extension
;# =====================================
sub CommentExtension {
	$ExtensionIntroducer   = ord(substr($buf, $cnt, 1)); $cnt++;
	$CommentLabel          = ord(substr($buf, $cnt, 1)); $cnt++;
	&DataSubBlock();

	if ($pflag) {
		printf("=====================================\n");
		printf("Comment Extension\n");
		printf("=====================================\n");
		printf("Extension Introducer:          0x%02x\n", $ExtensionIntroducer);
		printf("Comment Label:                 0x%02x\n", $CommentLabel);
		printf("Comment Data:                  ...\n");
		printf("Block Terminator:              0x%02x\n", $BlockTerminator);
	}
}

;# =====================================
;# Plain Text Extension
;# =====================================
sub PlainTextExtension {
	$ExtensionIntroducer  = ord(substr($buf, $cnt, 1)); $cnt++;
	$PlainTextLabel       = ord(substr($buf, $cnt, 1)); $cnt++;
	$BlockSize            = ord(substr($buf, $cnt, 1)); $cnt++;

examples/cgi/WwwCounter/gifcat.pl  view on Meta::CPAN

			      + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$TextGridHeight       = ord(substr($buf, $cnt, 1))
			      + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$CharacterCellWidth   = ord(substr($buf, $cnt, 1)); $cnt++;
	$CharacterCellHeight  = ord(substr($buf, $cnt, 1)); $cnt++;
	$TextForegroundColorIndex = ord(substr($buf, $cnt, 1)); $cnt++;
	$TextBackgroundColorIndex = ord(substr($buf, $cnt, 1)); $cnt++;
	&DataSubBlock();

	if ($pflag) {
		printf("=====================================\n");
		printf("Plain Text Extension\n");
		printf("=====================================\n");
		printf("Extension Introducer:        0x%02x\n", $ExtensionIntroducer);
		printf("Plain Text Label:            0x%02x\n", $PlainTextLabel);
		printf("Block Size:                  0x%02x\n", $BlockSize);
		printf("Text Grid Left Position:     %d\n", $TextGridLeftPosition);
		printf("Text Grid Top Position:      %d\n", $TextGridTopPosition);
		printf("Text Grid Width:             %d\n", $TextGridWidth);
		printf("Text Grid Height:            %d\n", $TextGridHeight);
		printf("Text Foreground Color Index: %d\n", $TextForegroundColorIndex);
		printf("Text Background Color Index: %d\n", $TextBackgroundColorIndex);
		printf("Plain Text Data:             ...\n");
		printf("Block Terminator:            0x00\n");
	}
}

;# =====================================
;# Application Extension
;# =====================================
sub ApplicationExtension {
	$ExtensionIntroducer           = ord(substr($buf, $cnt, 1)); $cnt++;
	$ExtentionLabel                = ord(substr($buf, $cnt, 1)); $cnt++;
	$BlockSize                     = ord(substr($buf, $cnt, 1)); $cnt++;
	$ApplicationIdentifire         = substr($buf, $cnt, 8); $cnt += 8;
	$ApplicationAuthenticationCode = substr($buf, $cnt, 3); $cnt += 3;
	&DataSubBlock();

	if ($pflag) {
		printf("=====================================\n");
		printf("Application Extension\n");
		printf("=====================================\n");
		printf("Extension Introducer:          0x%02x\n",
			$ExtensionIntroducer);
		printf("Extension Label:               0x%02x\n",
			$PlainTextLabel);
		printf("Block Size:                    0x%02x\n",
			$BlockSize);
		printf("Application Identifire:        ...\n");
		printf("ApplicationAuthenticationCode: ...\n");
		printf("Block Terminator:              0x00\n");
	}
}

;# =====================================
;# Trailer
;# =====================================
sub Trailer {
	$cnt++;

	if ($pflag) {
		printf("=====================================\n");
		printf("Trailer\n");
		printf("=====================================\n");
		printf("Trailer:                       0x3b\n");
		printf("\n");
	}
}

;# =====================================
;# Data Sub Block
;# =====================================
sub DataSubBlock {
	local($n, $from);
	$from = $cnt;
	while ($n = ord(substr($buf, $cnt, 1))) {

examples/cgi/WwwCounter/gifcat.pl  view on Meta::CPAN

;# =====================================
sub Dump {
	local($buf) = @_;
	my($i);

	if (length($buf) == 0) {
		return;
	}
	for ($i = 0; $i < length($buf); $i++) {
		if (($i % 16) == 0) {
			printf("  ");
		}
		printf("%02X ", ord(substr($buf, $i, 1)));
		if (($i % 16) == 15) {
			printf("\n");
		}
	}
	if (($i % 16) != 0) {
		printf("\n");
	}
}

1;

examples/cgi/WwwCounter/readme.html  view on Meta::CPAN

</ol>
<p>その外、再表示をちゃんと行っているか、画像の読み込みモードはオンになっているかなど、「とほほのCGI入門」の「CGIスクリプト作成時の注意」を参照してください。それでもうまã...
</div>

<h4>■ <a name="gifcat.pl">gifcat.plについて</a></h4>
<div class=i>
<p><a href="http://www.tohoho-web.com/wwwsoft.htm">gifcat.pl</a> は、GIF 画像を連結するPerl用フリーソフトライブラリです。改造、利用、転載、再配布など自由です。GIF アニメーションの機能を用いてã€...
<pre class=c>
require "gifcat.pl";
binmode(STDOUT);
print &amp;gifcat'gifcat("xxx.gif", "yyy.gif", "zzz.gif");
</pre>
</div>

<hr>
<div>Copyright (C) 1996-2003 杜甫々</div>
<div>最終更新:2003年3月23日</div>
<div>http://www.tohoho-web.com/soft/wcnt.htm</div>
</body>
</html>

examples/cgi/WwwCounter/wwwcount.cgi  view on Meta::CPAN

	return $count;
}

#
# カウンタをカウンタファイルに書き戻す
#
sub saveCount {
	my($count) = @_;

	if (open(OUT, "> $g_file_count")) {
		print(OUT "$count");
		close(OUT);
	}
}

#
# 日付ファイルから最終アクセス日付を読み出す。
#
sub readLastAccessDate {
	my $last_access_date;
	if (open(IN, "< $g_file_date")) {

examples/cgi/WwwCounter/wwwcount.cgi  view on Meta::CPAN

	return $last_access_date;
}

#
# 今日の日付を日付ファイルに書き出す
#
sub saveLastAccessDate {
	my($now_date) = @_;

	open(OUT, "> $g_file_date");
	print(OUT "$now_date");
	close(OUT);
}

#
# 今日の日付を得る
#
sub getCurrentDateAndTime {
	my($sec, $min, $hour, $mday, $mon, $year) = localtime(time());
	my($now_date) = sprintf("%04d/%02d/%02d", 1900 + $year, $mon + 1, $mday);
	my($now_time) = sprintf("%02d:%02d:%02d", $hour, $min, $sec);
	return $now_date, $now_time;
}

#
# アクセスログを初期化する
#
sub clearAccessLog {
	open(OUT, "> $g_file_access");
	close(OUT);
}

examples/cgi/WwwCounter/wwwcount.cgi  view on Meta::CPAN

# アクセスログを記録する
#
sub saveAccessLog {
	my($count, $now_time) = @_;
	my($addr, $host, $referer);
	local(*OUT);

	open(OUT, ">> $g_file_access");

	# カウント
	print(OUT "COUNT = [ $count ]\n");

	# 時刻
	print(OUT "TIME  = [ $now_time ]\n");

	# IPアドレス
	$addr = $ENV{'REMOTE_ADDR'};
	print(OUT "ADDR  = [ $addr ]\n");

	# ホスト名
	$host = $ENV{'REMOTE_HOST'};
	if ($g_addr_to_host && (($host eq "") || ($host eq $addr))) {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
	}
	if (($host ne "") && ($host ne $addr)) {
		print(OUT "HOST  = [ $host ]\n");
	}

	# エージェント名
	print(OUT "AGENT = [ $ENV{'HTTP_USER_AGENT'} ]\n");

	# リンク元(SSI)
	$referer = $ENV{'HTTP_REFERER'};
	if (($g_mode eq "text") && ($referer ne "")) {
		if ($g_decode_url) {
			$referer =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
		}
		print(OUT "REFER = [ $referer ]\n");
	}

	# リンク元(CGI)
	$g_referer =~ s/\\//g;
	if ($g_referer && (!$g_my_url || ($g_referer !~ /$g_my_url/))) {
		if ($g_decode_url) {
			$g_referer =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
		}
		print(OUT "FROM  = [ $g_referer ]\n");
	}

	print(OUT "\n");
	close(OUT);
}

#
# アクセスログをメールで送信する
#
sub sendReportMail {
	my($last_access_date) = @_;
	my($access_count);
	local(*IN, *OUT);

examples/cgi/WwwCounter/wwwcount.cgi  view on Meta::CPAN

	$access_count = 0;
	while (<IN>) {
		if (/^COUNT/) {
			$access_count++;
		}
	}
	close(IN);

	# レポートメールを送信する
	open(OUT, "| $g_sendmail -t -i");
	print OUT "To: $g_mailto\n";
	if ($g_mailfrom eq "") {
		print OUT "From: $g_counter_name\n";
	} else {
		print OUT "From: $g_mailfrom\n";
	}
	print OUT "Subject: ACCESS $last_access_date $access_count\n";
	print OUT "\n";
	if ($g_report_detail) {
		open(IN, "< $g_file_access");
		while (<IN>) {
			print OUT $_;
		}
		close(IN);
	} else {
		print OUT "Access = $access_count\n";
	}
	close(OUT);
}

#
# カウントアップするか否かを判断する
# すでに同アドレスからのアクセスがあればカウントアップしない
#
sub checkCountup {
	my($do_countup) = 1;

examples/cgi/WwwCounter/wwwcount.cgi  view on Meta::CPAN


#
# CGIスクリプトの結果としてカウンターを書き出す
#
sub outputCounter {
	my($count) = @_;
	my($count_str, @files, $size, $n, $buf);

	# カウンター文字列(例:000123)を得る
	if ($g_figure != 0) {
		$count_str = sprintf(sprintf("%%0%dld", $g_figure), $count);
	} else {
		$count_str = sprintf("%ld", $count);
	}

	# テキストモード
	if ($g_mode eq "text") {
		printf("Content-type: text/html\n");
		printf("\n");
		printf("$count_str\n");

	# GIFモード
	} elsif ($g_mode eq "gif") {
		printf("Content-type: image/gif\n");
		printf("\n");
		@files = ();
		for (my $i = 0; $i < length($count_str); $i++) {
			$n = substr($count_str, $i, 1);
			push(@files, "$n.gif");
		}
		require "./gifcat.pl";
		binmode(STDOUT);
		print gifcat'gifcat(@files);

	# 隠しカウンターモード
	} elsif ($g_mode eq "hide") {
		printf("Content-type: image/gif\n");
		printf("\n");
		$size = -s $g_gif_file;
		open(IN, $g_gif_file);
		binmode(IN);
		binmode(STDOUT);
		read(IN, $buf, $size);
		print $buf;
		close(IN);
	}
}

#
# ロックを得る
#
sub doLock {
	my($mtime);

examples/cgi/WwwCounter/wwwcount.cgi  view on Meta::CPAN

sub unlockLock {
	if ($g_lock_flag) {
		rmdir($g_file_lock);
	}
}

#
# CGIが使用できるかテストを行う。
#
sub test {
	print "Content-type: text/html\n";
	print "\n";
	print "<!doctype html>\n";
	print "<html>\n";
	print "<head>\n";
	print "<meta charset='utf-8'>\n";
    print "<title>Test</title>\n";
    print "</head>\n";
	print "<body>\n";
	print "<p>OK. CGIスクリプトは正常に動いています。</p>\n";
	if ($g_mailto ne "") {
		if (! -f $g_sendmail) {
			print "<p>ERROR: $g_sendmail が存在しません。</p>\n";
		}
	}
	if (!-d $g_lock_dir) {
		print "<p>ERROR: $g_lock_dir フォルダがありません。</p>\n";
	}
	if (-d $g_file_lock) {
		print "<p>ERROR: $g_file_lock が残っています。</p>\n";
	}
	if (! -r $g_file_count) {
		print "<p>ERROR: $g_file_count が存在しません。</p>\n";
	} elsif (! -w $g_file_count) {
		print "<p>ERROR: $g_file_count が書き込み可能ではありません。</p>\n";
	}
	if (! -r $g_file_date) {
		print "<p>ERROR: $g_file_date が存在しません。</p>\n";
	} elsif (! -w $g_file_date) {
		print "<p>ERROR: $g_file_date が書き込み可能ではありません。</p>\n";
	}
	if (! -r $g_file_access) {
		print "<p>ERROR: $g_file_access が存在しません。</p>\n";
	} elsif (! -w $g_file_access) {
		print "<p>ERROR: $g_file_access が書き込み可能ではありません。</p>\n";
	}
	if (($g_chdir ne "") && (! -d $g_chdir)) {
		print "<p>ERROR: $g_chdir が存在しません。</p>\n";
	}
	print "</body>\n";
	print "</html>\n";
}

examples/s3-get-object/handler.pl  view on Meta::CPAN

    my $payload = shift;
    # Get the object from the event and show its content type
    my $bucket = $payload->{Records}[0]{s3}{bucket}{name};
    my $key = uri_unescape($payload->{Records}[0]{s3}{object}{key} =~ s/\+/ /gr);
    my $resp = try {
        $obj->GetObject(
            Bucket => $bucket,
            Key    => $key,
        );
    } catch {
        print STDERR "$_\n";
        my $message = "Error getting object $key from bucket $bucket. Make sure they exist and your bucket is in the same region as this function.";
        print STDERR "$message\n";
        die $message;
    };

    printf STDERR "CONTENT TYPE: %s\n", $resp->ContentType;
    return $resp->ContentType;
}

1;

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


our $LAYERS = $AWS::Lambda::AL::LAYERS;
our $LAYERS_AL2 = $AWS::Lambda::AL2::LAYERS;
our $LAYERS_AL2023 = $AWS::Lambda::AL2023::LAYERS;

sub get_layer_info {
    my ($version, $region) = @_;
    return $LAYERS->{$version}{$region};
}

sub print_runtime_arn {
    my ($version, $region) = @_;
    print $LAYERS->{$version}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region) = @_;
    print $LAYERS->{$version}{$region}{paws_arn};
}

sub get_layer_info_al2 {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    return $LAYERS_AL2->{$version}{$arch}{$region};
}

sub print_runtime_arn_al2 {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS_AL2->{$version}{$arch}{$region}{runtime_arn};
}

sub print_paws_arn_al2 {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS_AL2->{$version}{$arch}{$region}{paws_arn};
}

sub get_layer_info_al2023 {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    return $LAYERS_AL2023->{$version}{$arch}{$region};
}

sub print_runtime_arn_al2023 {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS_AL2023->{$version}{$arch}{$region}{runtime_arn};
}

sub print_paws_arn_al2023 {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS_AL2023->{$version}{$arch}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda - Perl support for AWS Lambda Custom Runtime.

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

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-38-runtime-al2023-x86_64:1
    say $info->{runtime_version}; # 1
    say $info->{paws_arn}         # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-38-paws-al2023-x86_64:1
    say $info->{paws_version}     # 1,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::print_runtime_arn_al2023("5.38", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::print_paws_arn_al2023("5.38", "us-east-1")'

The list of all layer ARNs is available on L<AWS::Lambda::AL2023>.

=head2 Use Pre-built Zip Archives

=over

=item 1

Login to your AWS Account and go to the Lambda Console.

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

        --role arn:aws:iam::xxxxxxxxxxxx:role/service-role/lambda-custom-runtime-perl-role \
        --layers \
            "arn:aws:lambda:$REGION:445285296882:layer:perl-5-38-runtime-al2023-x86_64:5" \
            "arn:aws:lambda:$REGION:445285296882:layer:perl-5-38-paws-al2023-x86_64:4"

Now, you can use L<Paws> to call AWS API from your Lambda function.

    use Paws;
    my $obj = Paws->service('...');
    my $res = $obj->MethodCall(Arg1 => $val1, Arg2 => $val2);
    print $res->AttributeFromResult;

The list of all layer ARNs is available on L<AWS::Lambda::AL2023>.

URLs for Zip archive are:

C<https://shogo82148-lambda-perl-runtime-$REGION.s3.amazonaws.com/perl-$VERSION-paws-al2-$ARCHITECTURE.zip>

=head2 Use Prebuilt Docker Images for Paws

use the C<base-$VERSION-paws.al2023> tag on L<https://gallery.ecr.aws/shogo82148/p5-aws-lambda> or L<https://hub.docker.com/r/shogo82148/p5-aws-lambda>.

lib/AWS/Lambda/AL.pm  view on Meta::CPAN

        },
    },
};


sub get_layer_info {
    my ($version, $region) = @_;
    return $LAYERS->{$version}{$region};
}

sub print_runtime_arn {
    my ($version, $region) = @_;
    print $LAYERS->{$version}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region) = @_;
    print $LAYERS->{$version}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda::AL - AWS Lambda Custom Runtimes based on Amazon Linux

lib/AWS/Lambda/AL.pm  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-38-runtime:1
    say $info->{runtime_version}; # 1
    say $info->{paws_arn}         # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-38-paws:1
    say $info->{paws_version}     # 1,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::AL::print_runtime_arn("5.38", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::AL::print_paws_arn("5.38", "us-east-1")'

The list of all available layer ARN is:

=over

=item Perl 5.38

=over

=item C<arn:aws:lambda:af-south-1:445285296882:layer:perl-5-38-runtime:1>

lib/AWS/Lambda/AL2.pm  view on Meta::CPAN

    },
};


sub get_layer_info {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    return $LAYERS->{$version}{$arch}{$region};
}

sub print_runtime_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda::AL2 - AWS Lambda Custom Runtimes based on Amazon Linux 2

lib/AWS/Lambda/AL2.pm  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-42-runtime-al2-x86_64:2
    say $info->{runtime_version}; # 2
    say $info->{paws_arn}         # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-42-paws-al2-x86_64:1
    say $info->{paws_version}     # 1,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::print_runtime_arn("5.42", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::print_paws_arn("5.42", "us-east-1")'

The list of all available layer ARN is here:

=over

=item Perl 5.42

=over

=item x86_64 architecture

lib/AWS/Lambda/AL2023.pm  view on Meta::CPAN

    },
};


sub get_layer_info {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    return $LAYERS->{$version}{$arch}{$region};
}

sub print_runtime_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{runtime_arn};
}

sub print_paws_arn {
    my ($version, $region, $arch) = @_;
    $arch //= 'x86_64';
    print $LAYERS->{$version}{$arch}{$region}{paws_arn};
}

1;
__END__

=encoding utf-8

=head1 NAME

AWS::Lambda::AL2023 - AWS Lambda Custom Runtimes based on Amazon Linux 2023

lib/AWS/Lambda/AL2023.pm  view on Meta::CPAN

        "us-east-1", # Region
        "x86_64",    # Architecture ("x86_64" or "arm64", optional, the default is "x86_64")
    );
    say $info->{runtime_arn};     # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-42-runtime-al2023-x86_64:2
    say $info->{runtime_version}; # 2
    say $info->{paws_arn}         # arn:aws:lambda:us-east-1:445285296882:layer:perl-5-42-paws-al2023-x86_64:1
    say $info->{paws_version}     # 1,

Or, you can use following one-liner.

    perl -MAWS::Lambda -e 'AWS::Lambda::print_runtime_arn("5.42", "us-east-1")'
    perl -MAWS::Lambda -e 'AWS::Lambda::print_paws_arn("5.42", "us-east-1")'

The list of all available layer ARN is here:

=over

=item Perl 5.42

=over

=item x86_64 architecture

lib/AWS/Lambda/Bootstrap.pm  view on Meta::CPAN

sub handle_event {
    my $self = shift;
    $self->_init or return;
    my ($payload, $context) = $self->lambda_next;
    my $response = try {
        local $AWS::Lambda::context = $context;
        local $ENV{_X_AMZN_TRACE_ID} = $context->{trace_id};
        $self->{function}->($payload, $context);
    } catch {
        my $err = $_;
        print STDERR "$err";
        $self->lambda_error($err, $context);
        bless {}, 'AWS::Lambda::ErrorSentinel';
    };
    my $ref = ref($response);
    if ($ref eq 'AWS::Lambda::ErrorSentinel') {
        return;
    }
    if ($ref eq 'CODE') {
        $self->lambda_response_streaming($response, $context);
    } else {

lib/AWS/Lambda/Bootstrap.pm  view on Meta::CPAN

            my $content_type = shift;
            $writer = AWS::Lambda::ResponseWriter->new(
                response_url => $url,
                http         => $self->{http},
            );
            $writer->_request($content_type);
            return $writer;
        });
    } catch {
        my $err = $_;
        print STDERR "$err";
        if ($writer) {
            $writer->_close_with_error($err);
        } else {
            $self->lambda_error($err, $context);
        }
    };
    if ($writer) {
        my $response = $writer->_handle_response;
        if (!$response->{success}) {
            die "failed to response of execution: $response->{status} $response->{reason}";

lib/AWS/Lambda/ResponseWriter.pm  view on Meta::CPAN


    if ($self->{closed}) {
        # already closed
        croak "write failed: already closed";
    }

    if (!defined($data) || length($data) == 0) {
        return "0E0";
    }

    my $chunk  = sprintf '%X', length $data;
    $chunk .= "\x0D\x0A";
    $chunk .= $data;
    $chunk .= "\x0D\x0A";
    return $self->{handle}->write($chunk);
}

sub close {
    my $self = shift;
    if ($self->{closed}) {
        # already closed



( run in 1.258 second using v1.01-cache-2.11-cpan-de7293f3b23 )