AWS-XRay

 view release on metacpan or  search on metacpan

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

        $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;
    local $SAMPLED = $sampled;

    return $code->(AWS::XRay::Segment->new) if !$enabled;

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

    my $src   = shift;

    return bless {}, "${class}::NoTrace" if !$AWS::XRay::ENABLED;

    my $segment = {
        id         => AWS::XRay::new_id(),
        start_time => Time::HiRes::time(),
        trace_id   => $AWS::XRay::TRACE_ID,
        %$src,
    };
    if (my $parent_id = $AWS::XRay::SEGMENT_ID) {
        # This is a sub segment.
        $segment->{parent_id} = $parent_id;
        $segment->{type}      = "subsegment";
        $segment->{namespace} = "remote";
    }
    bless $segment, $class;
}

# alias for backward compatibility
*send = \&close;

sub close {

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

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";
is $seg1->{parent_id} => $root_id;
is $seg1->{trace_id}  => $trace_id;
is $seg1->{type}      => "subsegment";
ok $seg1->{start_time} >= $root->{start_time};
ok $seg1->{end_time} <= $root->{end_time};

# remote2
my $seg2 = pop @seg;
like $seg2->{id}      => qr/\A[0-9a-fA-F]{16}\z/;
is $seg2->{name}      => "remote2";
is $seg2->{parent_id} => $root_id;
is $seg2->{trace_id}  => $trace_id;
is $seg2->{type}      => "subsegment";
ok $seg2->{start_time} >= $seg1->{start_time};
ok $seg2->{end_time} <= $root->{end_time};

# remote3
my $seg3 = shift @seg;
like $seg3->{id}      => qr/\A[0-9a-fA-F]{16}\z/;
is $seg3->{name}      => "remote3";
is $seg3->{parent_id} => $seg2->{id};
is $seg3->{trace_id}  => $trace_id;
is $seg3->{type}      => "subsegment";
ok $seg3->{start_time} >= $seg2->{start_time};
ok $seg3->{end_time} <= $seg2->{end_time};

done_testing;

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

};

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

my $from = shift @seg;
is $from->{name}, "from";

my $to = shift @seg;
is $to->{name}      => "to";
is $to->{parent_id} => $from->{id};
is $to->{trace_id}  => $from->{trace_id};
is $to->{type}      => "subsegment";

done_testing;

t/05_sampled_header.t  view on Meta::CPAN

};

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

my $from = shift @seg;
is $from->{name}, "from";

my $to = pop @seg;
is $to->{name}      => "to";
is $to->{parent_id} => $from->{id};
is $to->{trace_id}  => $from->{trace_id};
is $to->{type}      => "subsegment";

my $sub = pop @seg;
is $sub->{name}      => "sub";
is $sub->{parent_id} => $to->{id};
is $sub->{trace_id}  => $from->{trace_id};
is $sub->{type}      => "subsegment";

done_testing;

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

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;
is $seg1->{trace_id}  => $trace_id;
is $seg1->{type}      => "subsegment";
ok $seg1->{start_time} >= $root->{start_time};
ok $seg1->{end_time} <= $root->{end_time};

# remote2
my $seg2 = pop @seg;
like $seg2->{id}      => qr/\A[0-9a-fA-F]{16}\z/;
is $seg2->{name}      => "remote2";
is $seg2->{parent_id} => $root_id;
is $seg2->{trace_id}  => $trace_id;
is $seg2->{type}      => "subsegment";
ok $seg2->{start_time} >= $seg1->{start_time};
ok $seg2->{end_time} <= $root->{end_time};

# remote3
my $seg3 = shift @seg;
like $seg3->{id}      => qr/\A[0-9a-fA-F]{16}\z/;
is $seg3->{name}      => "remote3";
is $seg3->{parent_id} => $seg2->{id};
is $seg3->{trace_id}  => $trace_id;
is $seg3->{type}      => "subsegment";
ok $seg3->{start_time} >= $seg2->{start_time};
ok $seg3->{end_time} <= $seg2->{end_time};

done_testing;