File Coverage

blib/lib/IO/Socket/ByteCounter.pm

Criterion	Covered	Total	%
statement	50	53	94.3
branch	5	14	35.7
condition			n/a
subroutine	12	12	100.0
pod	1	4	25.0
total	68	83	81.9

package IO::Socket::ByteCounter;

use base 'IO::Socket';

use strict;
# use warnings;

use version;our $VERSION = qv('0.0.2');

sub import {
    shift->record_bytes(@_) if @_;
}

sub record_bytes {
	my ($self, @pkgs)     =  @_;

    for my $pkg (@pkgs) {
        $pkg = ref $pkg if ref $pkg;

        my $inc = $pkg;
        $inc =~ s{::}{/}g;
        if(!exists $INC{$inc . '.pm'}) {
            eval "use $pkg;";
            warn $@ if $@;
            next if $@;
        }

        no strict;
        next if ${ "$pkg\::io_socket_bytecounter_on" };

        eval <<"OVERRIDE_END";
            \$$pkg\::io_socket_bytecounter_on = 1;

            #### IO::Socket methods ##
            # IO::Socket::send
            my \$send = \\&$pkg\::send;
            \*$pkg\::send = sub {
                my \$self = \$_[0];
                \${\*\$self}{'io_socket_bytecounter_out'} += IO::Socket::ByteCounter->_get_byte_size(\$_[1]);
	            \$send->(\@_);
            };

            # IO::Socket::recv
            my \$recv = \\&$pkg\::recv;
            \*$pkg\::recv = sub {
                my \$self = \$_[0];
		        \${\*\$self}{'io_socket_bytecounter_in'} += \$_[2];
		        \$recv->(\@_);
            };

            #### IO::Handle methods ##


            #### new methods ##

            sub $pkg\::get_bytes_in {
                my \$self = \$_[0];
                \${\*\$self}{'io_socket_bytecounter_in'};
            }

            sub $pkg\::get_bytes_out {
                my \$self = \$_[0];
                \${\*\$self}{'io_socket_bytecounter_out'};
            }

            sub $pkg\::get_bytes_total {
                my \$self = \$_[0];
                \${\*\$self}{'io_socket_bytecounter_in'} + \${\*\$self}{'io_socket_bytecounter_out'};
            }

OVERRIDE_END
    }

    return $@ ? 0 : 1;
}

sub _get_byte_size {
    my($self, @strings) = @_;
    my $bytes = 0;

    {
        use bytes;
        for my $string (@strings) {
            $bytes += length($string);
        }
    }

    return $bytes;
}

1;

__END__