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",
            PeerPort => $DAEMON_PORT || 2000,
            Proto    => "udp",
        ),
        $AUTO_FLUSH,
    );
}

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

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

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

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

sub capture {
    my ($name, $code) = @_;
    if (!is_valid_name($name)) {
        my $msg = "invalid segment name: $name";
        $CROAK_INVALID_NAME ? croak($msg) : carp($msg);
    }
    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;

    local $TRACE_ID = $TRACE_ID // new_trace_id();

    my $segment = AWS::XRay::Segment->new({ name => $name });
    unless (defined $segment->{type} && $segment->{type} eq "subsegment") {
        $_->apply_plugin($segment) for @PLUGINS;
    }

    local $SEGMENT_ID = $segment->{id};

    my @ret;
    eval {
        if ($wantarray) {
            @ret = $code->($segment);
        }
        elsif (defined $wantarray) {
            $ret[0] = $code->($segment);
        }
        else {
            $code->($segment);
        }
    };
    my $error = $@;
    if ($error) {
        $segment->{error} = Types::Serialiser::true;
        $segment->{cause} = {
            exceptions => [
                {
                    id      => new_id(),
                    message => "$error",
                    remote  => Types::Serialiser::true,
                },
            ],
        };
    }
    eval {
        $segment->close();
    };
    if ($@) {
        warn $@;
    }
    die $error if $error;
    return $wantarray ? @ret : $ret[0];
}

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

    local $AWS::XRay::SAMPLED = $sampled // $SAMPLER->();