AWS-XRay

 view release on metacpan or  search on metacpan

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

    }
    @PLUGINS;
}

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

sub sock {
    $Sock //= AWS::XRay::Buffer->new(
        IO::Socket::INET->new(
            PeerAddr => $DAEMON_HOST || "127.0.0.1",

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

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

    my $enabled;
    my $sampled = $SAMPLED;
    if (defined $ENABLED) {
        $enabled = $ENABLED ? 1 : 0; # fix true or false (not undef)
    }
    elsif ($TRACE_ID) {
        $enabled = 0;                # called from parent capture
    }
    else {
        # root capture try sampling
        $sampled = $SAMPLER->() ? 1 : 0;
        $enabled = $sampled     ? 1 : 0;
    }
    local $ENABLED = $enabled;

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

    # notify the Lambda Runtime that initialization is complete.
    unless (mkdir '/tmp/.aws-xray') {
        # ignore the error if the directory is already exits or other process created it.
        my $err = $!;
        unless (-d '/tmp/.aws-xray') {
            warn "failed to make directory: $err";
        }
    }
    open my $fh, '>', '/tmp/.aws-xray/initialized' or warn "failed to create file: $!";
    close $fh;
    utime undef, undef, '/tmp/.aws-xray/initialized' or warn "failed to touch file: $!";

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

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

    $seg->{annotations}->{foo} = "bar";
};

my @seg = segments();
ok @seg == 4;

my $root = pop @seg;
is $root->{name}, "myApp";
like $root->{trace_id} => qr/\A1-[0-9a-fA-F]{8}-[0-9a-fA-F]{24}\z/, "trace_id format";
like $root->{id}       => qr/\A[0-9a-fA-F]{16}\z/;
is $root->{type}, undef;
ok $root->{start_time} < $root->{end_time};
is $root->{annotations}->{foo} => "bar";

my $trace_id = $root->{trace_id};
my $root_id  = $root->{id};

# remote1
my $seg1 = shift @seg;
like $seg1->{id}      => qr/\A[0-9a-fA-F]{16}\z/;
is $seg1->{name}      => "remote1";

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

capture_from $header, "first", sub {
};

my @seg = segments;
ok @seg == 1;

my $root = shift @seg;
is $root->{name}, "first";
like $root->{trace_id} => qr/\A1-[0-9a-fA-F]{8}-[0-9a-fA-F]{24}\z/, "trace_id format";
like $root->{id}       => qr/\A[0-9a-fA-F]{16}\z/;
is $root->{type}, undef;

done_testing;

t/07_buffer.t  view on Meta::CPAN

    $b->print("ZZZ");
    is $buf => "foobarbazXXXYYYZZZ";
};

subtest "auto_flush=0", sub {
    my $buf;
    my $b = AWS::XRay::Buffer->new(IO::Scalar->new(\$buf), 0);
    $b->print("foo");
    $b->print("bar", "baz");
    is $buf => undef;

    $b->flush;
    is $buf => "foobarbaz";

    $b->print("XXX");
    is $buf => "foobarbaz";

    $b->flush;
    is $buf => "foobarbazXXX";

t/08_add.t  view on Meta::CPAN

my @seg = segments();
ok @seg == 4;

my $root = pop @seg;
is $root->{name}, "main";
is $root->{metadata}->{method},  "myApp";
is $root->{metadata}->{package}, "main";
like $root->{trace_id} => qr/\A1-[0-9a-fA-F]{8}-[0-9a-fA-F]{24}\z/, "trace_id format";
like $root->{id}       => qr/\A[0-9a-fA-F]{16}\z/;
is $root->{type}, undef;
ok $root->{start_time} < $root->{end_time};

my $trace_id = $root->{trace_id};
my $root_id  = $root->{id};

# remote1
my $seg1 = shift @seg;
like $seg1->{id}      => qr/\A[0-9a-fA-F]{16}\z/;
is $seg1->{name}      => "remote1";
is $seg1->{parent_id} => $root_id;

t/Util.pm  view on Meta::CPAN

my $buf;
no warnings 'redefine';

*AWS::XRay::sock = sub {
    IO::Scalar->new(\$buf);
};
1;

sub reset {
    undef $buf;
}

sub segments {
    return unless $buf;
    $buf =~ s/{"format":"json","version":1}//g;
    my @seg = split /\n/, $buf;
    shift @seg; # despose first ""
    return map { decode_json($_) } @seg;
}