File Coverage

blib/lib/Net/Google/Analytics/MeasurementProtocol.pm

Criterion	Covered	Total	%
statement	44	56	78.5
branch	7	20	35.0
condition	11	32	34.3
subroutine	6	9	66.6
pod	2	2	100.0
total	70	119	58.8

package Net::Google::Analytics::MeasurementProtocol;
use strict;
use warnings;
use Carp ();

our $VERSION = 0.05;

sub new {
    my $class = shift;
    my %args = (@_ == 1 ? %{$_[0]} : @_ );

    Carp::croak 'tracking_id (tid) missing or invalid'
        unless $args{tid} && $args{tid} =~ /^(?:UA|MO|YT)-\d+-\d+$/;

    # If the 'aip' key exists, even if set to 0, the ip will be anonymized.
    # So we only push it to our args if user set it to 1.
    delete $args{aip} if exists $args{aip} && !$args{aip};

    # default settings:
    $args{ua}  ||= __PACKAGE__ . "/$VERSION";
    $args{cid} ||= _gen_uuid_v4();
    $args{v}   ||= 1;
    $args{cd}  ||= '/';
    $args{an}  ||= 'My App';
    $args{ds}  ||= 'app';

    my $ua_object = delete $args{ua_object} || _build_user_agent( $args{ua} );
    unless ( $ua_object->isa('Furl') || $ua_object->isa('LWP::UserAgent') ) {
        Carp::croak('ua_object must be of type Furl or LWP::UserAgent');
    }

    my $debug = delete $args{debug};
    return bless {
        args  => \%args,
        debug => $debug,
        ua    => $ua_object,
    }, $class;
}

sub send {
    my ($self, $hit_type, $args) = @_;

    return $self->_request( $self->_build_request_args( $hit_type, $args ) );
}

sub _build_request_args {
    my ($self, $hit_type, $args) = @_;

    my %args = (%{$self->{args}}, %$args, t => $hit_type);
    my %required = (
        pageview    => [qw(v tid cid cd an)],
        screenview  => [qw(v tid cid cd an)],
        event       => [qw(v tid cid cd an ec ea)],
        transaction => [qw(v tid cid cd an ti)],
        item        => [qw(v tid cid cd an ti in)],
        social      => [qw(v tid cid cd an sn sa st)],
        exception   => [qw(v tid cid cd an)],
        timing      => [qw(v tid cid cd an utc utv utt)],
    );
    Carp::croak("invalid hit type $hit_type") unless $required{$hit_type};

    foreach my $required ( @{$required{$hit_type}} ) {
        Carp::croak("argument '$required' is required for '$hit_type' hit type. See https://developers.google.com/analytics/devguides/collection/protocol/v1/parameters#$required for more information")
            unless $args{$required};
    }
    Carp::croak('for "pageview" hit types you must set either "dl" or both "dh" and "dp"')
        if $hit_type eq 'pageview' && !($args{dl} || ($args{dh} && $args{dp}));
    return \%args;
}

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

    my $ua = $self->{ua};
    my $target = $self->{debug}
        ? 'https://www.google-analytics.com/debug/collect'
        : 'https://www.google-analytics.com/collect'
        ;

    # Compatibility layer for LWP::UserAgent
    my $res = $ua->post( $target, $ua->isa('Furl') ? undef : (), $args );

    return $self->{debug} ? $res : $res->is_success;
}

sub _build_user_agent {
    my ($ua) = @_;
    require Furl;
    return Furl->new( agent => $ua, timeout => 5 );
}

# UUID v4 (pseudo-random) generator based on UUID::Tiny
sub _gen_uuid_v4 {
    my $uuid = '';
    for ( 1 .. 4 ) {
        my $v1 = int(rand(65536)) % 65536;
        my $v2 = int(rand(65536)) % 65536;
        my $rand_32bit = ($v1 << 16) | $v2;
        $uuid .= pack 'I', $rand_32bit;
    }
    substr $uuid, 6, 1, chr( ord( substr( $uuid, 6, 1 ) ) & 0x0f | 0x40 );
    substr $uuid, 8, 1, chr( ord( substr( $uuid, 8, 1 ) ) & 0x3f | 0x80 );

    # uuid is created. Convert to string:
    return join '-',
           map { unpack 'H*', $_ }
           map { substr $uuid, 0, $_, '' }
           ( 4, 2, 2, 2, 6 );
}

1;
__END__