sub\s results from the CPAN

AWS-Lambda

view release on metacpan or search on metacpan

[![Actions Status](https://github.com/shogo82148/p5-aws-lambda/workflows/Test/badge.svg)](https://github.com/shogo82148/p5-aws-lambda/actions)
# NAME

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

# SYNOPSIS

Save the following Perl script as `handler.pl`.

    sub handle {
        my ($payload, $context) = @_;
        return $payload;
    }
    1;

and then, zip the script.

    $ zip handler.zip handler.pl

Finally, create new function using awscli.

README.md view on Meta::CPAN

    $ aws --region "$REGION" --profile "$PROFILE" lambda create-function \
        --function-name "hello-perl" \
        --zip-file "fileb://handler.zip" \
        --handler "handler.handle" \
        --runtime provided.al2023 \
        --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:1"

It also supports [response streaming](https://docs.aws.amazon.com/lambda/latest/dg/configuration-response-streaming.html).

    sub handle {
        my ($payload, $context) = @_;
        return sub {
            my $responder = shift;
            my $writer = $responder->('application/json');
            $writer->write('{"foo": "bar"}');
            $writer->close;
        };
    }

# DESCRIPTION

This package makes it easy to run AWS Lambda Functions written in Perl.

README.md view on Meta::CPAN

## AWS X-Ray SUPPORT

[AWS X-Ray](https://aws.amazon.com/xray/) is a service that collects data about requests that your application serves.
You can trace AWS Lambda requests and sends segment data with pre-install module [AWS::XRay](https://metacpan.org/pod/AWS%3A%3AXRay).

    use utf8;
    use warnings;
    use strict;
    use AWS::XRay qw/ capture /;

    sub handle {
        my ($payload, $context) = @_;
        capture "myApp" => sub {
            capture "nested" => sub {
                # do something ...
            };
        };
        capture "another" => sub {
            # do something ...
        };
        return;
    }

    1;

# Paws SUPPORT

If you want to call AWS API from your Lambda function,

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

use Perl::Strip;
use Plack::Request;
use AWS::Lambda::PSGI;

mkdir '/tmp/.perl-strip';
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);

    my $res = $req->new_response(200);
    $res->content_type('text/plain');
    $res->body($stripped);
    return $res->finalize;
};

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

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

1;

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

# Utility to strip POD from Perl module files.
# based on https://github.com/pplu/p5-pod-stripper

use v5.10;
use warnings;
use strict;
use File::Find ();
use Pod::Strip;
use autodie;

sub wanted;
sub dostrip;
sub delete_pod;

my $original_bytes = 0;
my $final_bytes = 0;

use Cwd ();
my $cwd = Cwd::cwd();

my @dirs;
if (@ARGV) {
  @dirs = @ARGV;

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


# 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) {
        dostrip($_);
    }

    if (-f _ && /^.*\.pod\z/s) {
        delete_pod($_);
    }

    $final_bytes += (-s $_ // 0);
}

sub delete_pod {
    my $file = shift;
    unlink $file;
}

sub dostrip {
    my $file = shift;

    my $strip = Pod::Strip->new;
    my $module;
    { local $/ = undef;
      open my $pm, '<', $file;
      $module = <$pm>;
      close $pm
    }

author/publish-perl-runtime-archives.pl view on Meta::CPAN

use 5.03800;
use strict;
use warnings;
use FindBin;
use Parallel::ForkManager;
use File::Basename 'basename';
use JSON qw(decode_json encode_json);

my $force = ($ARGV[0] // '') eq '-f';

sub head_or_put {
    my ($key, $zip) = @_;
    my $object = decode_json(`aws --output json --region us-east-1 s3api head-object --bucket shogo82148-lambda-perl-runtime-us-east-1 --key "$key" || echo "{}"`);
    my $current = $object->{Metadata}{md5chksum} || "";
    if (!$current) {
        say STDERR "Upload $zip to 3://shogo82148-lambda-perl-runtime-us-east-1/$key";
        my $cmd = "aws --output json --region 'us-east-1' s3api put-object --bucket 'shogo82148-lambda-perl-runtime-us-east-1' --key '$key' --body '$zip'";
        say STDERR "Executing: $cmd";
        if ($force) {
            $object = decode_json(`$cmd`);
            die "exit: $!" if $! != 0;
        }
    } else {
        say STDERR "s3://shogo82148-lambda-perl-runtime-us-east-1/$key is already updated";
    }
    return $object;
}

sub run_command {
    my @cmd = @_;
    say STDERR "Executing: @cmd";
    if ($force) {
        my $code = system(@cmd);
        die "exit: $code" if $! != 0;
    }
}

sub publish {
    my ($suffix, $arch, $arch_suffix) = @_;
    $arch_suffix //= "-$arch";

    for my $zip(glob "$FindBin::Bin/../.perl-layer/dist/perl-*-$suffix-$arch.zip") {
        chomp(my $sha256 = `openssl dgst -sha256 -r "$zip" | cut -d" " -f1`);
        my $name = basename($zip, '.zip');
        next unless $name =~ /^perl-([0-9]+)-([0-9]+)-/;
        my $perl_version = "$1.$2";

        head_or_put("$name/$sha256.zip", $zip);

author/publish-perl-runtimes.pl view on Meta::CPAN

use 5.03000;
use strict;
use warnings;
use FindBin;
use Parallel::ForkManager;
use File::Basename 'basename';
use JSON qw(decode_json);

my $force = ($ARGV[0] // '') eq '-f';

sub head_or_put {
    my ($region, $key, $zip, $md5) = @_;
    my $object = decode_json(`aws --output json --region "$region" s3api head-object --bucket "shogo82148-lambda-perl-runtime-$region" --key "$key" || echo "{}"`);
    my $current = $object->{Metadata}{md5chksum} || "";
    if ($current ne $md5) {
        say STDERR "Upload $zip to 3://shogo82148-lambda-perl-runtime-$region/$key";
        my $cmd = "aws --output json --region '$region' s3api put-object --bucket 'shogo82148-lambda-perl-runtime-$region' --key '$key' --body '$zip' --content-md5 '$md5' --metadata md5chksum='$md5'";
        say STDERR "Executing: $cmd";
        if ($force) {
            $object = decode_json(`$cmd`);
            die "exit: $!" if $! != 0;
        }
    } else {
        say STDERR "$zip in s3://shogo82148-lambda-perl-runtime-$region/$key is already updated";
    }
    return $object;
}

sub run_command {
    my @cmd = @_;
    say STDERR "Executing: @cmd";
    if ($force) {
        my $code = system(@cmd);
        die "exit: $code" if $! != 0;
    }
}

sub publish {
    my ($suffix, $arch, $arch_suffix) = @_;
    $arch_suffix //= "-$arch";
    my $pm = Parallel::ForkManager->new(10);

    my $regions = do {
        open my $fh, '<', "$FindBin::Bin/regions-$arch.txt" or die "$!";
        my @regions = sort { $a cmp $b } map { chomp; $_; } <$fh>;
        close($fh);
        \@regions;
    };

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

    "5.32",
    "5.30",
    "5.28",
    "5.26",
];
$versions = [sort {version->parse("v$b") <=> version->parse("v$a")} @$versions];

# get the list of layers on Amazon Linux 1
my $layers = {};
my $pm = Parallel::ForkManager->new(10);
$pm->run_on_finish(sub {
    my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_;
    return unless $data;
    my ($version, $region, $arn) = @$data;
    return unless $version && $region && $arn;
    $layers->{$version} //= {};
    $layers->{$version}{$region} = $arn;
});

for my $version (@$versions) {
    for my $region (@{$regions->{x86_64}}) {

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

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

            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

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

    "5.38",
    "5.36",
    "5.34",
    "5.32",
];
$versions_al2 = [sort {version->parse("v$b") <=> version->parse("v$a")} @$versions_al2];

# get the list of layers on Amazon Linux 2
my $layers_al2_x86_64 = {};
my $pm_al2_x86_64 = Parallel::ForkManager->new(10);
$pm_al2_x86_64->run_on_finish(sub {
    my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_;
    return unless $data;
    my ($version, $region, $arn) = @$data;
    return unless $version && $region && $arn;

    $layers_al2_x86_64->{$version} //= {};
    $layers_al2_x86_64->{$version}{$region} = $arn;
});

for my $version (@$versions_al2) {

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

            paws_arn        => $paws_arn,
            paws_version    => (split /:/, $paws_arn)[-1],
        }]);
    }
}
$pm_al2_x86_64->wait_all_children;

# get the list of layers on Amazon Linux 2 for each arch
my $layers_al2 = {};
my $pm_al2 = Parallel::ForkManager->new(10);
$pm_al2->run_on_finish(sub {
    my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_;
    return unless $data;
    my ($version, $region, $arch, $arn) = @$data;
    return unless $version && $region && $arch && $arn;
    $layers_al2->{$version} //= {};
    $layers_al2->{$version}{$region} //= {};
    $layers_al2->{$version}{$region}{$arch} = $arn;
});

for my $version (@$versions_al2) {

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

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

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

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


my $versions_al2023 = [
    "5.40",
    "5.38",
];
$versions_al2023 = [sort {version->parse("v$b") <=> version->parse("v$a")} @$versions_al2023];

# get the list of layers on Amazon Linux 2 for each arch
my $layers_al2023 = {};
my $pm_al2023 = Parallel::ForkManager->new(10);
$pm_al2023->run_on_finish(sub {
    my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_;
    return unless $data;
    my ($version, $region, $arch, $arn) = @$data;
    return unless $version && $region && $arch && $arn;
    $layers_al2023->{$version} //= {};
    $layers_al2023->{$version}{$region} //= {};
    $layers_al2023->{$version}{$region}{$arch} = $arn;
});

for my $version (@$versions_al2023) {

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

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

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

cpanfile view on Meta::CPAN

requires 'JSON::XS', '4.0';
requires 'Try::Tiny', '0.30';
requires 'Plack', '1.0047';
requires 'Plack::Middleware::ReverseProxy', '0.16';
requires 'JSON::Types', '0.05';
requires 'URI::Escape';
requires 'MIME::Base64';

recommends 'AWS::XRay', '>=0.09';

on 'test' => sub {
    requires 'Test::More', '0.98';
    requires 'Test::Deep', '1.128';
    requires 'Test::TCP', '2.19';
    requires 'Test::SharedFork';
    requires 'Test::Warn';
    requires 'File::Slurp', '9999.25';
    requires 'Starman';
};

on 'develop' => sub {
    requires 'Minilla';
    requires 'Version::Next';
    requires 'CPAN::Uploader';
    requires 'Software::License::MIT';
    requires 'Test::CPAN::Meta';
    requires 'Test::Pod';
    requires 'Test::MinimumVersion::Fast';
    requires 'Mojolicious';
    requires 'Dancer2';
    requires 'Parallel::ForkManager';

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

;#
;# ====================================================================

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 = @_;
	$Gif = 0;
	$leftpos = 0;
	$logicalScreenWidth = 0;
	$logicalScreenHeight = 0;
	$useLocalColorTable = 0;
	
	foreach $file (@files) {
		$size = -s $file;
		open(IN, "$file") || return("ERROR");

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

		$GifImage .= pack("C", $LzwMinimumCodeSize[$j]);
		$GifImage .= $ImageData[$j];
	}
	$GifImage .= pack("C", 0x3b);

}

;# =====================================
;# GifHeader
;# =====================================
sub GifHeader {
	$Signature = substr($buf, $cnt, 3); $cnt += 3;
	$Version   = substr($buf, $cnt, 3); $cnt += 3;
	$LogicalScreenWidth
			= ord(substr($buf, $cnt + 0, 1))
			+ ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$LogicalScreenHeight
			= ord(substr($buf, $cnt + 0, 1))
			+ ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$PackedFields18[$Gif]   = ord(substr($buf, $cnt, 1)); $cnt++;
	$GlobalColorTableFlag   = ($PackedFields18[$Gif] & 0x80) >> 7;

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

		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))
			   + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$ImageTopPosition  = ord(substr($buf, $cnt, 1))
			   + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$ImageWidth[$Gif]  = ord(substr($buf, $cnt, 1))
			   + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$ImageHeight       = ord(substr($buf, $cnt, 1))
			   + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$PackedFields20[$Gif]  = ord(substr($buf, $cnt, 1)); $cnt++;

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

		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++;
	$PackedFields23        = ord(substr($buf, $cnt, 1)); $cnt++;
	$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;

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

		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++;
	$TextGridLeftPosition = ord(substr($buf, $cnt, 1))
			      + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$TextGridTopPosition  = ord(substr($buf, $cnt, 1))
			      + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$TextGridWidth        = ord(substr($buf, $cnt, 1))
			      + ord(substr($buf, $cnt + 1, 1)) * 256; $cnt += 2;
	$TextGridHeight       = ord(substr($buf, $cnt, 1))

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

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

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

			$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))) {
		$cnt++;
		$cnt += $n;
	}
	$cnt++;
	return(substr($buf, $from, $cnt - $from));
}

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

	if (length($buf) == 0) {
		return;
	}
	for ($i = 0; $i < length($buf); $i++) {
		if (($i % 16) == 0) {
			printf("  ");
		}

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

use warnings;
use strict;
use lib "$ENV{'LAMBDA_TASK_ROOT'}/local/lib/perl5";
use AWS::Lambda::PSGI;

$ENV{WWWCOUNT_DIR} ||= "/tmp";
chdir($ENV{'LAMBDA_TASK_ROOT'});
my $app = require "$ENV{'LAMBDA_TASK_ROOT'}/app.psgi";
my $func = AWS::Lambda::PSGI->wrap($app);

sub handle {
    my $payload = shift;
    return $func->($payload);
}

1;

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

	# CGIã®çµæžœã¨ã—ã¦ã‚«ã‚¦ãƒ³ã‚¿ãƒ¼ã‚’æ›¸ãå‡ºã™
	outputCounter($count);

	# ãƒãƒƒã‚¯ã‚’è§£æ”¾ã™ã‚‹
	unlockLock();
}

#
# å¼•æ•°ã‚’è§£é‡ˆã™ã‚‹
#
sub parseArguments {
	my(@argv) = split(/\+/, $ENV{'QUERY_STRING'});

	for (my $i = 0; $i <= $#argv; $i++) {
		# ãƒ†ã‚¹ãƒˆãƒ¢ãƒ¼ãƒ‰
		if ($argv[$i] eq "test") {
			$g_mode = "test";

		# ãƒ†ã‚ã‚¹ãƒˆãƒ¢ãƒ¼ãƒ‰
		} elsif ($argv[$i] eq "text") {
			$g_mode = "text";

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

		# ãƒªãƒ³ã‚¯å…ƒ
		} elsif ($argv[$i] eq "ref") {
			$g_referer = $argv[++$i];
		}
	}
}

#
# ã‚«ã‚¦ãƒ³ã‚¿ãƒ¼ãƒ•ã‚¡ã‚¤ãƒ«ã‹ã‚‰ã‚«ã‚¦ãƒ³ã‚¿ãƒ¼å€¤ã‚’èªã¿å‡ºã™ã€‚
#
sub readCount {
	my($count) = 0;
	local(*IN);

	if (open(IN, "< $g_file_count")) {
		$count = <IN>;
		close(IN);
	}
	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")) {
		$last_access_date = <IN>;
		close(IN);
	} else {
		$last_access_date = "";
	}
	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);
}

#
# ã‚¢ã‚¯ã‚»ã‚¹ãƒã‚°ã‚’è¨˜éŒ²ã™ã‚‹
#
sub saveAccessLog {
	my($count, $now_time) = @_;
	my($addr, $host, $referer);
	local(*OUT);

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

	# ã‚«ã‚¦ãƒ³ãƒˆ
	print(OUT "COUNT = [ $count ]\n");

	# æ™‚åˆ»

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

		print(OUT "FROM  = [ $g_referer ]\n");
	}

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

#
# ã‚¢ã‚¯ã‚»ã‚¹ãƒã‚°ã‚’ãƒ¡ãƒ¼ãƒ«ã§é€ä¿¡ã™ã‚‹
#
sub sendReportMail {
	my($last_access_date) = @_;
	my($access_count);
	local(*IN, *OUT);

	if ($g_mailto eq "") {
		return;
	}

	# ã‚¢ã‚¯ã‚»ã‚¹ä»¶æ•°ã‚’èªã¿å–ã‚‹
	open(IN, "< $g_file_access");

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

	} else {
		print OUT "Access = $access_count\n";
	}
	close(OUT);
}

#
# ã‚«ã‚¦ãƒ³ãƒˆã‚¢ãƒƒãƒ—ã™ã‚‹ã‹å¦ã‹ã‚’åˆ¤æ–ã™ã‚‹
# ã™ã§ã«åŒã‚¢ãƒ‰ãƒ¬ã‚¹ã‹ã‚‰ã®ã‚¢ã‚¯ã‚»ã‚¹ãŒã‚ã‚Œã°ã‚«ã‚¦ãƒ³ãƒˆã‚¢ãƒƒãƒ—ã—ãªã„
#
sub checkCountup {
	my($do_countup) = 1;
	local(*IN);

	if ($g_address_check) {
		open(IN, "$g_file_access");
		while (<IN>) {
			if ($_ eq "ADDR  = [ $ENV{'REMOTE_ADDR'} ]\n") {
				$do_countup = 0;
				last;
			}
		}
		close(IN);
	}
	return $do_countup;
}

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

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

		binmode(STDOUT);
		read(IN, $buf, $size);
		print $buf;
		close(IN);
	}
}

#
# ãƒãƒƒã‚¯ã‚’å¾—ã‚‹
#
sub doLock {
	my($mtime);

	if ($g_lock_flag) {
		for (my $i = 1; $i <= 6; $i++) {
			if (mkdir("$g_file_lock", 0755)) {
				# ãƒãƒƒã‚¯æˆåŠŸã€‚æ¬¡ã®å‡¦ç†ã¸ã€‚
				last;
			} elsif ($i == 1) {
				# 10åˆ†ä»¥ä¸Šå¤ã„ãƒãƒƒã‚¯ãƒ•ã‚¡ã‚¤ãƒ«ã¯å‰Šé™¤ã™ã‚‹ã€‚
				($mtime) = (stat($g_file_lock))[9];

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

				# ãƒãƒƒã‚¯å¤±æ•—ã€‚1ç§’å¾…ã£ã¦å†ãƒˆãƒ©ã‚¤ã€‚
				sleep(1);
			} else {
				# ä½•åº¦ã‚„ã£ã¦ã‚‚ãƒãƒƒã‚¯å¤±æ•—ã€‚ã‚ãã‚‰ã‚ã‚‹ã€‚
				exit(1);
			}
		}
	}

	# é€”ä¸ã§çµ‚äº†ã—ã¦ã‚‚ãƒãƒƒã‚¯ãƒ•ã‚¡ã‚¤ãƒ«ãŒæ®‹ã‚‰ãªã„ã‚ˆã†ã«ã™ã‚‹
	sub sigexit { rmdir($g_file_lock); exit(0); }
	$SIG{'PIPE'} = $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = "sigexit";
}

#
# ãƒãƒƒã‚¯ã‚’é–‹æ”¾ã™ã‚‹
#
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";

examples/custom-docker/handler.pl view on Meta::CPAN

use utf8;
use warnings;
use strict;

sub handle {
    my $payload = shift;
    return +{"hello" => "lambda"};
}

1;

examples/docker/handler.pl view on Meta::CPAN

use utf8;
use warnings;
use strict;

sub handle {
    my $payload = shift;
    return +{"hello" => "lambda"};
}

1;

examples/hello/handler.pl view on Meta::CPAN

use utf8;
use warnings;
use strict;

sub handle {
    my $payload = shift;
    return +{"hello" => "lambda"};
}

1;

examples/psgi/app.psgi view on Meta::CPAN

use strict;
use warnings;
use utf8;
use Plack::Request;
use Plack::Builder;
use Data::Dumper;

return builder {
    mount '/foo' => sub {
        my $env = shift;
        my $req = Plack::Request->new($env);

        my $meth = $req->method;
        if ($meth eq 'POST') {
            return [
                200,
                ['Content-Type', 'application/octet-stream'],
                [$req->content],
            ]
        }

        return [
            405,
            ['Content-Type', 'text/plain'],
            ['Method Not Allowed'],
        ]
    };
    mount '/' => sub {
        my $env = shift;
        return [
            200,
            ['Content-Type', 'text/plain'],
            [Dumper($env)],
        ]
    };
};

examples/psgi/handler.pl view on Meta::CPAN

use utf8;
use warnings;
use strict;
use AWS::Lambda::PSGI;

my $app = require "$ENV{'LAMBDA_TASK_ROOT'}/app.psgi";
my $func = AWS::Lambda::PSGI->wrap($app);

sub handle {
    my $payload = shift;
    return $func->($payload);
}

1;

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

use warnings;
use strict;
use 5.30.0;
use lib "$ENV{'LAMBDA_TASK_ROOT'}/extlocal/lib/perl5";
use Paws;
use Try::Tiny;
use URI::Escape;

my $obj = Paws->service('S3', region => 'ap-northeast-1');

sub handle {
    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 {

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


our $VERSION = "0.5.4";

# the context of Lambda Function
our $context;

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.

=head1 SYNOPSIS

Save the following Perl script as C<handler.pl>.

    sub handle {
        my ($payload, $context) = @_;
        return $payload;
    }
    1;

and then, zip the script.

    $ zip handler.zip handler.pl

Finally, create new function using awscli.

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

    $ aws --region "$REGION" --profile "$PROFILE" lambda create-function \
        --function-name "hello-perl" \
        --zip-file "fileb://handler.zip" \
        --handler "handler.handle" \
        --runtime provided.al2023 \
        --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:1"

It also supports L<response streaming|https://docs.aws.amazon.com/lambda/latest/dg/configuration-response-streaming.html>.

    sub handle {
        my ($payload, $context) = @_;
        return sub {
            my $responder = shift;
            my $writer = $responder->('application/json');
            $writer->write('{"foo": "bar"}');
            $writer->close;
        };
    }

=head1 DESCRIPTION

This package makes it easy to run AWS Lambda Functions written in Perl.

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

=head2 AWS X-Ray SUPPORT

L<AWS X-Ray|https://aws.amazon.com/xray/> is a service that collects data about requests that your application serves.
You can trace AWS Lambda requests and sends segment data with pre-install module L<AWS::XRay>.

    use utf8;
    use warnings;
    use strict;
    use AWS::XRay qw/ capture /;

    sub handle {
        my ($payload, $context) = @_;
        capture "myApp" => sub {
            capture "nested" => sub {
                # do something ...
            };
        };
        capture "another" => sub {
            # do something ...
        };
        return;
    }

    1;


=head1 Paws SUPPORT

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

        'us-west-2' => {
            runtime_arn     => "arn:aws:lambda:us-west-2:445285296882:layer:perl-5-26-runtime:21",
            runtime_version => 21,
            paws_arn        => "arn:aws:lambda:us-west-2:445285296882:layer:perl-5-26-paws:11",
            paws_version    => 11,
        },
    },
};


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

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

                runtime_arn     => "arn:aws:lambda:us-west-2:445285296882:layer:perl-5-32-runtime-al2-arm64:6",
                runtime_version => 6,
                paws_arn        => "arn:aws:lambda:us-west-2:445285296882:layer:perl-5-32-paws-al2-arm64:6",
                paws_version    => 6,
            },
        },
    },
};


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

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

                runtime_arn     => "arn:aws:lambda:us-west-2:445285296882:layer:perl-5-38-runtime-al2023-arm64:9",
                runtime_version => 9,
                paws_arn        => "arn:aws:lambda:us-west-2:445285296882:layer:perl-5-38-paws-al2023-arm64:6",
                paws_version    => 6,
            },
        },
    },
};


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

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

use JSON::XS qw/decode_json encode_json/;
use Try::Tiny;
use AWS::Lambda;
use AWS::Lambda::Context;
use AWS::Lambda::ResponseWriter;
use Scalar::Util qw(blessed);
use Exporter 'import';

our @EXPORT = ('bootstrap');

sub bootstrap {
    my $handler = shift;
    my $bootstrap = AWS::Lambda::Bootstrap->new(
        handler => $handler,
    );
    $bootstrap->handle_events;
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %args;
    if (@_ == 1 && ref $_[0] eq 'HASH') {
        %args = %{$_[0]};
    } else {
        %args = @_;
    }

    my $api_version = '2018-06-01';

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

        next_event_url => "http://${runtime_api}/${api_version}/runtime/invocation/next",
        http           => HTTP::Tiny->new(
            # XXX: I want to disable timeout, but it seems HTTP::Tiny does not support it.
            # So, I set a long timeout.
            timeout => 365*24*60*60, # 365 days
        ),
    }, $class;
    return $self;
}

sub handle_events {
    my $self = shift;
    $self->_init or return;
    while(1) {
        $self->handle_event;
    }
}

sub _init {
    my $self = shift;
    if (my $func = $self->{function}) {
        return $func;
    }

    my $task_root = $self->{task_root};
    my $handler = $self->{handler};
    my $name = $self->{function_name};
    return try {
        package main;
        require "${task_root}/${handler}.pl";
        my $f = main->can($name) // die "handler $name is not found";
        $self->{function} = $f;
    } catch {
        $self->lambda_init_error($_);
        $self->{function} = sub {};
        undef;
    };
}

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

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

        return;
    }
    if ($ref eq 'CODE') {
        $self->lambda_response_streaming($response, $context);
    } else {
        $self->lambda_response($response, $context);
    }
    return 1;
}

sub lambda_next {
    my $self = shift;
    my $resp = $self->{http}->get($self->{next_event_url});
    if (!$resp->{success}) {
        die "failed to retrieve the next event: $resp->{status} $resp->{reason}";
    }
    my $h = $resp->{headers};
    my $payload = decode_json($resp->{content});
    return $payload, AWS::Lambda::Context->new(
        deadline_ms          => $h->{'lambda-runtime-deadline-ms'},
        aws_request_id       => $h->{'lambda-runtime-aws-request-id'},
        invoked_function_arn => $h->{'lambda-runtime-invoked-function-arn'},
        trace_id             => $h->{'lambda-runtime-trace-id'},
    );
}

sub lambda_response {
    my $self = shift;
    my ($response, $context) = @_;
    my $runtime_api = $self->{runtime_api};
    my $api_version = $self->{api_version};
    my $request_id = $context->aws_request_id;
    my $url = "http://${runtime_api}/${api_version}/runtime/invocation/${request_id}/response";
    my $resp = $self->{http}->post($url, {
        content => encode_json($response),
    });
    if (!$resp->{success}) {
        die "failed to response of execution: $resp->{status} $resp->{reason}";
    }
}

sub lambda_response_streaming {
    my $self = shift;
    my ($response, $context) = @_;
    my $runtime_api = $self->{runtime_api};
    my $api_version = $self->{api_version};
    my $request_id = $context->aws_request_id;
    my $url = "http://${runtime_api}/${api_version}/runtime/invocation/${request_id}/response";
    my $writer = undef;
    try {
        $response->(sub {
            my $content_type = shift;
            $writer = AWS::Lambda::ResponseWriter->new(
                response_url => $url,
                http         => $self->{http},
            );
            $writer->_request($content_type);
            return $writer;
        });
    } catch {
        my $err = $_;

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

        }
    };
    if ($writer) {
        my $response = $writer->_handle_response;
        if (!$response->{success}) {
            die "failed to response of execution: $response->{status} $response->{reason}";
        }
    }
}

sub lambda_error {
    my $self = shift;
    my ($error, $context) = @_;
    my $runtime_api = $self->{runtime_api};
    my $api_version = $self->{api_version};
    my $request_id = $context->aws_request_id;
    my $url = "http://${runtime_api}/${api_version}/runtime/invocation/${request_id}/error";
    my $type = blessed($error) // "Error";
    my $resp = $self->{http}->post($url, {
        content => encode_json({
            errorMessage => "$error",
            errorType => "$type",
        }),
    });
    if (!$resp->{success}) {
        die "failed to send error of execution: $resp->{status} $resp->{reason}";
    }
}

sub lambda_init_error {
    my $self = shift;
    my $error = shift;
    my $runtime_api = $self->{runtime_api};
    my $api_version = $self->{api_version};
    my $url = "http://${runtime_api}/${api_version}/runtime/init/error";
    my $type = blessed($error) // "Error";
    my $resp = $self->{http}->post($url, {
        content => encode_json({
            errorMessage => "$error",
            errorType => "$type",

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

    bootstrap(@ARGV);

Prebuild Perl Runtime Layer includes the C<bootstrap> script.
So, if you use the Layer, no need to include the C<bootstrap> script into your zip.
See L<AWS::Lambda> for more details.

=head1 DESCRIPTION

The format of the handler is following.

    sub handle {
        my ($payload, $context) = @_;
        # handle the event here.
        my $result = {};
        return $result;
    }

C<$context> is an instance of L<AWS::Lambda::Context>.

=head1 RESPONSE STREAMING

It also supports L<response streaming|https://docs.aws.amazon.com/lambda/latest/dg/configuration-response-streaming.html>.

    sub handle {
        my ($payload, $context) = @_;
        return sub {
            my $responder = shift;
            my $writer = $responder->('application/json');
            $writer->write('{"foo": "bar"}');
            $writer->close;
        };
    }

=head1 LICENSE

The MIT License (MIT)

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

package AWS::Lambda::Context;
use 5.026000;
use strict;
use warnings;

use Time::HiRes qw(time);

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %args;
    if (@_ == 1 && ref $_[0] eq 'HASH') {
        %args = %{$_[0]};
    } else {
        %args = @_;
    }
    my $deadline_ms = $args{deadline_ms} // die 'deadine_ms is required';
    my $invoked_function_arn = $args{invoked_function_arn} // '';

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

    my $self = bless +{
        deadline_ms          => +$deadline_ms,
        invoked_function_arn => $invoked_function_arn,
        aws_request_id       => $aws_request_id,
        trace_id             => $trace_id,
    }, $class;

    return $self;
}

sub get_remaining_time_in_millis {
    my $self = shift;
    return $self->{deadline_ms} - time() * 1000;
}

sub function_name {
    return $ENV{AWS_LAMBDA_FUNCTION_NAME} // die 'function_name is not found';
}

sub function_version {
    return $ENV{AWS_LAMBDA_FUNCTION_VERSION} // die 'function_version is not found';
}

sub invoked_function_arn {
    my $self = shift;
    return $self->{invoked_function_arn};
}

sub memory_limit_in_mb {
    return +$ENV{AWS_LAMBDA_FUNCTION_MEMORY_SIZE} // die 'memory_limit_in_mb is not found';
}

sub aws_request_id {
    my $self = shift;
    return $self->{aws_request_id};
}

sub log_group_name {
    return $ENV{AWS_LAMBDA_LOG_GROUP_NAME} // die 'log_group_name is not found';
}

sub log_stream_name {
    return $ENV{AWS_LAMBDA_LOG_STREAM_NAME} // die 'log_stream_name is not found';
}

sub identity {
    return undef; # TODO
}

sub client_context {
    return undef; # TODO
}

1;
=encoding utf-8

=head1 NAME

AWS::Lambda::Context - It's Perl port of the AWS Lambda Context.

=head1 SYNOPSIS

    sub handle {
        my ($payload, $context) = @_;
        # $context is an instance of AWS::Lambda::Context
        my $result = {
            # The name of the Lambda function.
            function_name => $context->function_name,

            # The version of the function.
            function_version => $context->function_version,
            
            # The Amazon Resource Name (ARN) used to invoke the function.

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

use bytes ();
use MIME::Base64;
use JSON::Types;
use Encode;
use Try::Tiny;
use Plack::Middleware::ReverseProxy;
use AWS::Lambda;
use Scalar::Util qw(reftype);
use JSON::XS qw(encode_json);

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
 
    my $self;
    if (@_ == 1 && ref $_[0] eq 'HASH') {
        $self = bless {%{$_[0]}}, $class;
    } else {
        $self = bless {@_}, $class;
    }

    if (!defined $self->{invoke_mode}) {
        my $mode = $ENV{PERL5_LAMBDA_PSGI_INVOKE_MODE}
            || $ENV{AWS_LWA_INVOKE_MODE}; # for compatibility with https://github.com/awslabs/aws-lambda-web-adapter
        $self->{invoke_mode} = uc $mode;
    }
 
    return $self;
}

sub prepare_app { return }

sub app {
    return $_[0]->{app} if scalar(@_) == 1;
    return $_[0]->{app} = scalar(@_) == 2 ? $_[1] : [ @_[1..$#_ ]];
}

sub to_app {
    my $self = shift;
    $self->prepare_app;
    return sub { $self->call(@_) };
}

sub wrap {
    my($self, $app, @args) = @_;

    # Lambda function runs as reverse proxy backend.
    # So, we always enable ReverseProxy middleware.
    $app = Plack::Middleware::ReverseProxy->wrap($app);

    if (ref $self) {
        $self->{app} = $app;
    } else {
        $self = $self->new({ app => $app, @args });
    }
    return $self->to_app;
}

sub call {
    my($self, $env, $ctx) = @_;

    # $ctx is added by #26
    # fall back to $AWS::Lambda::context because of backward compatibility.
    $ctx ||= $AWS::Lambda::context;

    if ($self->{invoke_mode} eq "RESPONSE_STREAM") {
        my $input = $self->_format_input_v2($env, $ctx);
        $input->{'psgi.streaming'} = Plack::Util::TRUE;
        my $res = $self->app->($input);
        return $self->_handle_response_stream($res);
    } else {
        my $input = $self->format_input($env, $ctx);
        my $res = $self->app->($input);
        return $self->format_output($res);
    }
}

sub format_input {
    my ($self, $payload, $ctx) = @_;
    if (my $context = $payload->{requestContext}) {
        if ($context->{elb}) {
            # Application Load Balancer https://docs.aws.amazon.com/elasticloadbalancing/latest/application/lambda-functions.html
            return $self->_format_input_v1($payload, $ctx);
        }
    }
    if (my $version = $payload->{version}) {
        if ($version =~ /^1[.]/) {
            # API Gateway for REST https://docs.aws.amazon.com/apigateway/latest/developerguide/set-up-lambda-proxy-integrations.html
            return $self->_format_input_v1($payload, $ctx);
        }
        if ($version =~ /^2[.]/) {
            # API Gateway for HTTP https://docs.aws.amazon.com/apigateway/latest/developerguide/http-api-develop-integrations-lambda.html
            return $self->_format_input_v2($payload, $ctx);
        }
    }
    return $self->_format_input_v1($payload, $ctx);
}

sub _format_input_v1 {
    my ($self, $payload, $ctx) = @_;
    my $env = {};

    # merge queryStringParameters and multiValueQueryStringParameters
    my $query = {
        %{$payload->{queryStringParameters} // {}},
        %{$payload->{multiValueQueryStringParameters} // {}},
    };
    my @params;
    while (my ($key, $value) = each %$query) {

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

        my $path = $requestContext->{path};
        my $stage = $requestContext->{stage};
        if ($stage && $path && $path ne $payload->{path}) {
            $env->{SCRIPT_NAME} = "/$stage";
        }
    }

    return $env;
}

sub _format_input_v2 {
    my ($self, $payload, $ctx) = @_;
    my $env = {};

    $env->{QUERY_STRING} = $payload->{rawQueryString};

    my $headers = $payload->{headers} // {};
    while (my ($key, $value) = each %$headers) {
        $key =~ s/-/_/g;
        $key = uc $key;
        if ($key !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {

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

    $env->{REQUEST_METHOD} = $requestContext->{http}{method};
    $env->{REQUEST_URI} = $payload->{rawPath};
    if ($env->{QUERY_STRING}) {
        $env->{REQUEST_URI} .= '?' . $env->{QUERY_STRING};
    }
    $env->{PATH_INFO} = $requestContext->{http}{path};
    $env->{SCRIPT_NAME} = '';
    return $env;
}

sub format_output {
    my ($self, $response) = @_;
    my ($status, $headers, $body) = @$response;

    my $singleValueHeaders = {};
    my $multiValueHeaders = {};
    Plack::Util::header_iter($headers, sub {
        my ($k, $v) = @_;
        $singleValueHeaders->{lc $k} = string $v;
        push @{$multiValueHeaders->{lc $k} //= []}, string $v;
    });

    my $content = '';
    if (reftype($body) eq 'ARRAY') {
        $content = join '', grep defined, @$body;
    } else {
        local $/ = \4096;

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


    return +{
        isBase64Encoded => bool $isBase64Encoded,
        headers => $singleValueHeaders,
        multiValueHeaders => $multiValueHeaders,
        statusCode => number $status,
        body => string $content,
    }
}

sub _handle_response_stream {
    my ($self, $response) = @_;
    if (reftype($response) ne "CODE") {
        my $orig = $response;
        $response = sub {
            my $responder = shift;
            $responder->($orig);
        };
    }

    return sub {
        my $lambda_responder = shift;
        my $psgi_responder = sub {
            my $response = shift;
            my ($status, $headers, $body) = @$response;

            # write the prelude.
            my $writer = $lambda_responder->("application/vnd.awslambda.http-integration-response");
            my $prelude = encode_json($self->_format_response_stream($status, $headers));
            $prelude .= "\x00\x00\x00\x00\x00\x00\x00\x00";
            $writer->write($prelude) or die "failed to write prelude: $!";

            # write the body.

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

                    $writer->write($chunk) or die "failed to write chunk: $!";
                }
            }
            $writer->close or die "failed to close writer: $!";
            return;
        };
        $response->($psgi_responder);
    };
}

sub _format_response_stream {
    my ($self, $status, $headers) = @_;
    my $headers_hash = {};
    my $cookies = [];

    Plack::Util::header_iter($headers, sub {
        my ($k, $v) = @_;
        $k = lc $k;
        if ($k eq 'set-cookie') {
            push @$cookies, string $v;
        } elsif (exists $headers_hash->{$k}) {
            $headers_hash->{$k} = ", $v";
        } else {
            $headers_hash->{$k} = string $v;
        }
    });

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

Add the following script into your Lambda code archive.

    use utf8;
    use warnings;
    use strict;
    use AWS::Lambda::PSGI;

    my $app = require "$ENV{'LAMBDA_TASK_ROOT'}/app.psgi";
    my $func = AWS::Lambda::PSGI->wrap($app);

    sub handle {
        return $func->(@_);
    }

    1;

And then, L<Set up Lambda Proxy Integrations in API Gateway|https://docs.aws.amazon.com/apigateway/latest/developerguide/set-up-lambda-proxy-integrations.html> or
L<Lambda Functions as ALB Targets|https://docs.aws.amazon.com/elasticloadbalancing/latest/application/lambda-functions.html>

=head1 DESCRIPTION

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

            FunctionUrlConfig:
                AuthType: NONE
                InvokeMode: RESPONSE_STREAM
            Environment:
                Variables:
                PERL5_LAMBDA_PSGI_INVOKE_MODE: RESPONSE_STREAM
            # (snip)

In this mode, the PSGI server accespts L<Delayed Response and Streaming Body|https://metacpan.org/pod/PSGI#Delayed-Response-and-Streaming-Body>.

    my $app = sub {
        my $env = shift;
    
        return sub {
            my $responder = shift;
            $responder->([ 200, ['Content-Type' => 'text/plain'], [ "Hello World" ] ]);
        };
    };

An application MAY omit the third element (the body) when calling the responder.

    my $app = sub {
        my $env = shift;
    
        return sub {
            my $responder = shift;
            my $writer = $responder->([ 200, ['Content-Type' => 'text/plain'] ]);
            $writer->write("Hello World");
            $writer->close;
        };
    };

=head2 Request ID

L<AWS::Lambda::PSGI> injects the request id that compatible with L<Plack::Middleware::RequestId>.

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

use Carp qw(croak);
use Scalar::Util qw(blessed);
use MIME::Base64 qw(encode_base64);
use HTTP::Tiny;

my %DefaultPort = (
    http => 80,
    https => 443,
);

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %args;
    if (@_ == 1 && ref $_[0] eq 'HASH') {
        %args = %{$_[0]};
    } else {
        %args = @_;
    }

    my $http = $args{http} // HTTP::Tiny->new;

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

    my $content_type = $args{content_type} // 'application/json';
    my $self = bless +{
        response_url => $response_url,
        http         => $http,
        handle       => undef,
        closed       => 0,
    }, $class;
    return $self;
}

sub _request {
    my ($self, $content_type) = @_;
    my $response_url = $self->{response_url};
    my $http = $self->{http};
    my ($scheme, $host, $port, $path_query, $auth) = $http->_split_url($response_url);
    my $host_port = ($port == $DefaultPort{$scheme} ? $host : "$host:$port");
    my $request = {
        method    => "POST",
        scheme    => $scheme,
        host      => $host,
        port      => $port,

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

            $handle->close;
            undef $handle;
        }
    }
    $handle ||= $http->_open_handle( $request, $scheme, $host, $port, $peer );
    $self->{handle} = $handle;

    $handle->write_request_header(@{$request}{qw/method uri headers header_case/});
}

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

    my $http = $self->{http};
    my $handle = $self->{handle};
    my $response;
    do { $response = $handle->read_response_header }
        until (substr($response->{status},0,1) ne '1');

    my $data_cb = $http->_prepare_data_cb($response, {});
    my $known_message_length = $handle->read_body($data_cb, $response);
    $handle->close;

    $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
    $response->{url} = $self->{response_url};
    return $response;
}

sub write {
    my ($self, $data) = @_;

    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
        return;
    }
    my $handle = $self->{handle};
    $self->{closed} = 1;
    return $handle->write("0\x0D\x0A\x0D\x0A");
}

sub _close_with_error {
    my ($self, $error) = @_;
    if ($self->{closed}) {
        # already closed
        return;
    }
    $self->{closed} = 1;
    my $handle = $self->{handle};
    $handle->write("0\x0D\x0A");
    my $type = blessed($error) // "Error";
    return $handle->write_header_lines({

t/01_echo.t view on Meta::CPAN

    deadline_ms          => 1000,
    aws_request_id       => '8476a536-e9f4-11e8-9739-2dfe598c3fcd',
    invoked_function_arn => 'arn:aws:lambda:us-east-2:123456789012:function:custom-runtime',
    trace_id             => "Root=1-5bef4de7-ad49b0e87f6ef6c87fc2e700;Parent=9a9197af755a6419;Sampled=1",
);

my $bootstrap = BootstrapMock->new(
    handler     => "echo.handle",
    runtime_api => "example.com",
    task_root   => "$FindBin::Bin/test_handlers",
    lambda_next => sub {
        return $payload, $dummy_context;
    },
    lambda_response => sub {
        my $self = shift;
        $response = shift;
        $context = shift;
    },
);

ok $bootstrap->handle_event;
cmp_deeply $response, $payload, "echo handler";
is $context, $dummy_context, "context";

t/02_error.t view on Meta::CPAN


use FindBin;
use lib "$FindBin::Bin/lib";
use BootstrapMock;

my $error;
my $bootstrap = BootstrapMock->new(
    handler     => "error.handle",
    runtime_api => "example.com",
    task_root   => "$FindBin::Bin/test_handlers",
    lambda_next => sub {
        return +{
            key1 => 1,
            key2 => 2,
            key3 => 3,
        }, undef;
    },
    lambda_error => sub {
        my $self = shift;
        $error = shift;
    },
);

ok !$bootstrap->handle_event;
like $error, qr/some error/;
done_testing;

t/03_init_error.t view on Meta::CPAN

use lib "$FindBin::Bin/lib";
use BootstrapMock;
use AWS::Lambda::Context;
use Try::Tiny;

my $error;
my $bootstrap = BootstrapMock->new(
    handler     => "init_error.handle",
    runtime_api => "example.com",
    task_root   => "$FindBin::Bin/test_handlers",
    lambda_init_error => sub {
        my $self = shift;
        $error = shift;
    },
);

ok !$bootstrap->handle_event;
like $error, qr/did not return a true value/;

done_testing;

t/04_handler_not_found.t view on Meta::CPAN

use lib "$FindBin::Bin/lib";
use BootstrapMock;
use AWS::Lambda::Context;
use Try::Tiny;

my $error;
my $bootstrap = BootstrapMock->new(
    handler     => "echo.handle_not_found",
    runtime_api => "example.com",
    task_root   => "$FindBin::Bin/test_handlers",
    lambda_init_error => sub {
        my $self = shift;
        $error = shift;
    },
);

ok !$bootstrap->handle_event;
like $error, qr/handler handle_not_found is not found/;

done_testing;

( run in 0.438 second using v1.01-cache-2.11-cpan-4d50c553e7e )