#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use POSIX qw( CLOCKS_PER_SEC );
use Time::HiRes qw( gettimeofday CLOCK_REALTIME );

use constant TRUE      => scalar 1;
use constant ARGUMENTS => scalar 1;
use constant MAXBYTES  => scalar 512;
use constant MAX_PORT  => scalar 65536;
use constant MIN_PORT  => scalar 1;

my $dot = ".";
my ( $rcv_sntp_packet , $root_dispersion , $server_send_microsec_epoc 
+, $precision_client , $client_microsec_ref_d );

if ( @ARGV > ARGUMENTS ) {
    print "\nPlease no more than ".ARGUMENTS." argument input!\n";
    print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:12345)\n"
+;
    exit(0);
}
elsif ( @ARGV < ARGUMENTS ) {
    print "\nPlease no less than ".ARGUMENTS." argument input!\n";
    print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:12345)\n"
+;
    exit(0);
}
else {

    my $info = $ARGV[0]; # User input IP:PORT;

    my $string = index($info, ':');

    if ($string == '-1') {
    die "Please include ':' in between the IP and Port - ".$info."\n";
    }

    my @input = split( ':' , $info );

    die "\nPlease use PORT number between ".MIN_PORT." - ".MAX_PORT."\
+n\n" 
    if ( ( $input[1] > MAX_PORT ) || ( $input[1] < MIN_PORT ) );

    my $client_socket = new IO::Socket::INET (
    PeerHost => $input[0],
    Type     => SOCK_DGRAM,
    PeerPort => $input[1], # Default NTP port 123, due to permission d
+enied switch to client set
    Proto    => 'udp'
    ) or die "ERROR in Socket Creation: $@\n";

    my $Peer_Port = $client_socket->peerport();
    
    while (TRUE) {
    
    my $li = 0; # is the client we have no warning for asynchronizatio
+n on the first round
    my $li_b = dec2bin( $li , 8 , "c" );
    $li_b = substr $li_b, -2;

    my $vn = 3; # is the version 3 only IPV4
    my $vn_b = dec2bin( $vn , 8 , "c" );
    $vn_b = substr $vn_b, -3;

    my $mode = 3; # is the client (mode 3)
    my $mode_b = dec2bin( $mode , 8 , "c" );
    $mode_b = substr $mode_b, -3;

    my $stratum = 15; # is the client clock with SNTP synchronization
    my $stratum_b = dec2bin( $stratum , 8 , "C" );

    my $poll = 6; # is the poll interval between messages 2**0 (2 to t
+he power of 0) = 0 sec
    my $poll_b = dec2bin( $poll , 8 , "c" );

    # The precission size on the RFC is 8 bits, anything lower than 1e
+-03 (0.001) it can not fit on 8 bits. In such cases we round to closs
+est digit. Never the less the value is so small not even worth mentio
+ning it. Range from -6 for mains-frequency clocks to -20

    ( undef , undef , $precision_client , undef , undef ) = POSIX::tim
+es() ;

    my $precision_b = dec2bin( $precision_client , 8 , "c" );

    my $root_delay = 0; # Initializing the client root delay is 0 we n
+eed at least on receive to have new root delay
    my $root_delay_b = dec2bin( $root_delay , 32 , "f" );

        # is the nominal error relative to the primary reference, we n
+eed the hardware clock to know and compare with the current time in o
+rder to get the value. And update the value when we will receive the 
+message from the server.
    if ( defined $client_microsec_ref_d ) {
        $server_send_microsec_epoc = $dot . $server_send_microsec_epoc
+;
        $client_microsec_ref_d = $dot . $client_microsec_ref_d;
        $root_dispersion = $client_microsec_ref_d - $server_send_micro
+sec_epoc;
    }
    else {
        $root_dispersion = 0;
    }

    my $root_dispersion_b = dec2bin( $root_dispersion , 32 , "f" );

    my $reference_identifier = 0; # this is the client In the case of 
+NTP Version 3 or Version 4 stratum-0 (unspecified)
    my $reference_identifier_b = dec2bin( $reference_identifier , 32 ,
+ "N" );
    
    # NTP uses 64-bit Time Stamps to exchange information. Two parts a
+re used, 32-bits for seconds and 32-bits for portions of a second. Th
+e 64-bit Time Stamp can manage 136 years of time based from January 1
+, 1970. Ref. http://www.linux.org/threads/tcp-ip-protocol-network-tim
+e-protocol-ntp.4912/

    # Client epoc ref in sec and microsec
    my ( $client_sec_ref_d , $client_microsec_ref_d ) = gettimeofday()
+;

    # Convert to binary epoc ref seconds
    my $client_sec_ref_b = dec2bin( $client_sec_ref_d , 32 , "N" );

    # Convert to binary epoc ref micro seconds
    my $client_microsec_ref_b = dec2bin( $client_microsec_ref_d , 32 ,
+ "N" );

    # Concatenate the epoc ref sec and micro sec to a string 64 bits l
+ong to send
    my $client_epoc_ref_b = $client_sec_ref_b . $client_microsec_ref_b
+;

    # Print decimal epoc ref message
    my $client_epoc_ref_d = $client_sec_ref_d . $dot . $client_microse
+c_ref_d;

    # Client epoc send in sec and microsec
    my ( $client_sec_send_d , $client_microsec_send_d ) = gettimeofday
+();

    # Convert to binary epoc send seconds
    my $client_sec_send_b = dec2bin( $client_sec_send_d , 32 , "N" );

    # Convert to binary epoc send micro seconds
    my $client_microsec_send_b = dec2bin( $client_microsec_send_d , 32
+ , "N" );

    # Concatenate the epoc send sec and micro sec to a string 64 bits 
+long to send
    my $client_epoc_send_b = $client_sec_send_b . $client_microsec_sen
+d_b;

    # Print decimal epoc send message
    my $client_epoc_send_d = $client_sec_send_d . $dot . $client_micro
+sec_send_d;

    my $send_sntp_packet = $li_b . $vn_b . $mode_b . $stratum_b . $pol
+l_b . $precision_b . $root_delay_b . $root_dispersion_b . $reference_
+identifier_b . $client_epoc_ref_b . $client_epoc_send_b;

    $client_socket->send( $send_sntp_packet ) 
        or die "Client error while send: $!\n";

    $client_socket->recv( $rcv_sntp_packet , MAXBYTES )
        or die "Client error while received: $!\n";

    # Client epoc rcv in sec and microsec
    my ( $client_sec_rcv_d , $client_microsec_rcv_d ) = gettimeofday()
+;

    # Print decimal epoc rcv message
    my $client_epoc_rcv_d = $client_sec_rcv_d . $dot . $client_microse
+c_rcv_d;

    die "Client check send MSG!\n" if ( $rcv_sntp_packet eq "Invalid R
+equest" );

    my $server_li_binary = substr( $rcv_sntp_packet , 0 , 2 );
    my $server_li = bin2dec( $server_li_binary , 8 , "c" );

    my $server_vn_binary = substr( $rcv_sntp_packet , 2 , 3 );
    my $server_vn = bin2dec( $server_vn_binary , 8 , "c" );

    my $server_mode_binary = substr( $rcv_sntp_packet , 5 , 3 );
    my $server_mode = bin2dec( $server_mode_binary , 8 , "c" );

    my $server_stratum_binary = substr( $rcv_sntp_packet , 8 , 8 );
    my $server_stratum = bin2dec( $server_stratum_binary , 8 , "C" );

    my $server_poll_interval_binary = substr( $rcv_sntp_packet , 16 , 
+8 );
    my $server_poll_interval = bin2dec( $server_poll_interval_binary ,
+ 32 , "N" );

    my $server_precision_binary = substr( $rcv_sntp_packet , 24 , 8 );
    my $server_precision = bin2dec( $server_precision_binary , 32 , "N
+" );

    my $server_root_delay_binary = substr( $rcv_sntp_packet , 32 , 32 
+);
    my $server_root_delay = bin2dec( $server_root_delay_binary , 32 , 
+"f" );

    my $server_root_dispersion_binary = substr( $rcv_sntp_packet , 64 
+, 32 );
    my $server_root_dispersion = bin2dec( $server_root_dispersion_bina
+ry , 32 , "N" );

    my $server_ref_identifier_binary = substr( $rcv_sntp_packet , 96 ,
+ 32 );
    my $server_ref_identifier  = pack("B32", $server_ref_identifier_bi
+nary);

    my $client_ref_sec_epoc_b = substr( $rcv_sntp_packet , 128 , 32 );
    my $client_ref_sec_epoc = bin2dec( $client_ref_sec_epoc_b , 32 , "
+N" );

    my $client_ref_microsec_epoc_b = substr( $rcv_sntp_packet , 160 , 
+32 );
    my $client_ref_microsec_epoc = bin2dec( $client_ref_microsec_epoc_
+b , 32 , "N" );

    my $client_ref_epoc_total = $client_ref_sec_epoc . $dot . $client_
+ref_microsec_epoc;

    # Concatenate client ref sec and ref microsec for server message t
+ransmission
    my $client_epoc_ref_binary = $client_ref_sec_epoc_b . $client_ref_
+microsec_epoc_b;

    my $client_send_sec_epoc_b = substr( $rcv_sntp_packet , 192 , 32 )
+;
    my $client_send_sec_epoc = bin2dec( $client_send_sec_epoc_b , 32 ,
+ "N" );

    my $client_send_microsec_epoc_b = substr( $rcv_sntp_packet , 224 ,
+ 32 );
    my $client_send_microsec_epoc = bin2dec( $client_send_microsec_epo
+c_b , 32 , "N" );

    my $client_send_epoc_d = $client_send_sec_epoc . $dot . $client_se
+nd_microsec_epoc;
    
    # Concatenate client ref sec and ref microsec for server message t
+ransmission
    my $client_epoc_send_binary = $client_send_sec_epoc_b . $client_se
+nd_microsec_epoc_b;

    my $server_rcv_sec_epoc_b = substr( $rcv_sntp_packet , 256 , 32 );
    my $server_rcv_sec_epoc = bin2dec( $server_rcv_sec_epoc_b , 32 , "
+N" );

    my $server_rcv_microsec_epoc_b = substr( $rcv_sntp_packet , 288 , 
+32 );
    my $server_rcv_microsec_epoc = bin2dec( $server_rcv_microsec_epoc_
+b , 32 , "N" );

    my $server_rcv_epoc_d = $server_rcv_sec_epoc . $dot . $server_rcv_
+microsec_epoc;

    my $server_send_sec_epoc_b = substr( $rcv_sntp_packet , 320 , 32 )
+;
    my $server_send_sec_epoc = bin2dec( $server_send_sec_epoc_b , 32 ,
+ "N" );

    my $server_send_microsec_epoc_b = substr( $rcv_sntp_packet , 352 ,
+ 32 );
    $server_send_microsec_epoc = bin2dec( $server_send_microsec_epoc_b
+ , 32 , "N" );

    my $server_send_epoc_d = $server_send_sec_epoc . $dot . $server_se
+nd_microsec_epoc;

    # RFC2030 reference http://tools.ietf.org/html/rfc2030

    my $d = (($client_epoc_rcv_d -  $client_epoc_send_d) - ($server_rc
+v_epoc_d - $server_send_epoc_d));
    my $t = ((($server_rcv_epoc_d -  $client_epoc_send_d) + ($server_s
+end_epoc_d - $client_epoc_rcv_d))/2);
    
        # Clear screen for viewing the output
    system $^O eq 'MSWin32' ? 'cls' : 'clear';

    print "
\t Timestamp Name \t ID \t When Generated
\t ------------------------------------------------------------
\t Originate Timestamp \t T1 \t time request sent by client
\t Receive Timestamp \t T2 \t time request received by server
\t Transmit Timestamp \t T3 \t time reply sent by server
\t Destination Timestamp \t T4 \t time reply received by client

\t The roundtrip delay d and local clock offset t are defined as

\t d = (T4 - T1) - (T2 - T3) \t t = ((T2 - T1) + (T3 - T4)) / 2 \n

\t Round Trip delay: ".$d."\n
\t Clock offset: ".$t."\n

\t Field Name \t\t\t Unicast/Anycast
\t\t\t\t Request \t\t Reply
\t ------------------------------------------------------------
\t LI \t\t\t $li \t\t\t $server_li
\t VN \t\t\t $vn \t\t\t $server_vn
\t Mode \t\t\t $mode \t\t\t $server_mode
\t Stratum \t\t $stratum \t\t\t $server_stratum
\t Poll \t\t\t $poll \t\t\t $server_poll_interval
\t Precision \t\t $precision_client \t\t\t $server_precision
\t Root Delay \t\t $root_delay \t\t\t $server_root_delay
\t Root Dispersion \t $root_dispersion \t\t\t $server_root_dispersion
\t Reference Identifier \t $reference_identifier \t\t\t $server_ref_id
+entifier
\t Reference Timestamp \t $client_epoc_ref_d \t $server_rcv_epoc_d
\t Originate Timestamp \t $client_epoc_send_d \t $server_send_epoc_d
\t Receive Timestamp \t $client_epoc_rcv_d \t $server_rcv_epoc_d
\t Transmit Timestamp \t $client_epoc_send_d \t $server_send_epoc_d\n"
+;

    sleep(2**$server_poll_interval);
    # Clear screen for viewing the output
    system $^O eq 'MSWin32' ? 'cls' : 'clear';

    } # End of While (TRUE)

    $client_socket->close(); # Close socket()

} # End of else ARGV provided

sub dec2bin {
    my $bits      = shift;
    my $size      = shift;
    my $template  = shift;
    my $str = unpack("B$size", pack($template, $bits));
    return $str;
}

sub bin2dec {
    my $bits     = shift;
    my $size     = shift;
    my $template = shift;
    return unpack($template, pack("B$size", substr("0" x $size . $bits
+ , -$size)));
}
[download]

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use POSIX qw( CLOCKS_PER_SEC );
use Time::HiRes qw( gettimeofday CLOCK_REALTIME );

use constant TRUE      => scalar 1;
use constant ARGUMENTS => scalar 1;
use constant MAXBYTES  => scalar 256;
use constant MAX_PORT  => scalar 65536;
use constant MIN_PORT  => scalar 1;

my $dot = ".";
my ( $rcv_sntp_packet , $li_d , $send_sntp_packet , $precision_server 
+);

if ( @ARGV > ARGUMENTS ) {
    print "\nPlease no more than ".ARGUMENTS." argument input!\n";
    print "\nCorrect Syntax: perl $0 PORT (e.g. 5000)\n";
    exit();
}
elsif ( @ARGV < ARGUMENTS ) {
    print "\nPlease no less than ".ARGUMENTS." argument input!\n";
    print "\nCorrect Syntax: perl $0 PORT (e.g. 5000)\n";
    exit();
}
else {

    my $port = $ARGV[0]; # User input PORT;

    die "\nPlease provide only numeric characters for PORT number!\n\n
+"
    if ( $port =~ /\D/ );

    die "\nPlease use PORT number between ".MIN_PORT." - ".MAX_PORT."\
+n\n" 
    if ( ( $port > MAX_PORT ) || ( $port < MIN_PORT ) );

    my $server_socket = IO::Socket::INET->new(
    LocalPort  => $port, # Default NTP port 123
    Proto      => 'udp',
    Type       => SOCK_DGRAM,
    LocalAddr  => 'localhost',
    Broadcast  => 1 ) or die "Can't bind: $@\n";

    printf("\nServer is up, listens on PORT: ".$port." waiting for cli
+ent...\n");

    while ( TRUE ) {

    my $peer_address = $server_socket->peerhost();
    my $peer_port = $server_socket->peerport();
    
    if ( defined $peer_address ) { print "Peer address: ".$peer_addres
+s."\n" };
    if ( defined $peer_port ) { print "Peer port: ".$peer_port."\n" };
    
    # read operation on the socket
    $server_socket->recv( $rcv_sntp_packet , MAXBYTES ) 
        or die "Server error received: $!\n";
    my ( $server_rcv_epoc_sec , $server_rcv_epoc_microsec ) = gettimeo
+fday(); # Server epoc time in sec and microsec

    # Convert to binary epoc rcv seconds
    my $server_sec_rcv_b = dec2bin( $server_rcv_epoc_sec , 32 , "N" );
    #print "Epoc rcv sec ".$server_sec_rcv_b."\n";

    # Convert to binary epoc rcv micro seconds
    my $server_microsec_rcv_b = dec2bin( $server_rcv_epoc_microsec , 3
+2 , "N" );
    #print "Epoc rcv microsec ".$server_microsec_rcv_b."\n";

    # Concatenate the rcv sec and rcv microsec 64 in total
    my $server_epoc_rcv_b = $server_sec_rcv_b . $server_microsec_rcv_b
+;
    #print "Length of rcv time server: ".length( $server_epoc_rcv_b ).
+"\n";

    my $server_rcv_epoc_d = $server_rcv_epoc_sec . $dot . $server_rcv_
+epoc_microsec;

    #print "\n\n" . "Server received: ".$rcv_sntp_packet."\n\n";

    if ( !defined $rcv_sntp_packet ) {
        $send_sntp_packet = "Invalid Request";

        $server_socket->send( $send_sntp_packet )
        or die "Server error send:  $!\n";
    }
    else {

        my $client_li_binary = substr( $rcv_sntp_packet , 0 , 2 );
        my $client_li = bin2dec( $client_li_binary , 8 , "c" );

        my $client_vn_binary = substr( $rcv_sntp_packet , 2 , 3 );
        my $client_vn = bin2dec( $client_vn_binary , 8 , "c" );

        my $client_mode_binary = substr( $rcv_sntp_packet , 5 , 3 );
        my $client_mode = bin2dec( $client_mode_binary , 8 , "c" );

        my $client_stratum_binary = substr( $rcv_sntp_packet , 8 , 8 )
+;
        my $client_stratum = bin2dec( $client_stratum_binary , 8 , "C"
+ );

        my $client_poll_interval_binary = substr( $rcv_sntp_packet , 1
+6 , 8 );
        my $client_poll_interval = bin2dec( $client_poll_interval_bina
+ry , 8 , "c" );

        my $client_precision_binary = substr( $rcv_sntp_packet , 24 , 
+8 );
        my $client_precision = bin2dec( $client_precision_binary , 8 ,
+ "c" );

        my $client_root_delay_binary = substr( $rcv_sntp_packet , 32 ,
+ 32 );
        my $client_root_delay = bin2dec( $client_root_delay_binary , 3
+2 , "f" );

        my $client_root_dispersion_binary = substr( $rcv_sntp_packet ,
+ 64 , 32 );
        my $client_root_dispersion = bin2dec( $client_root_dispersion_
+binary , 32 , "N" );

        my $client_ref_identifier_binary = substr( $rcv_sntp_packet , 
+96 , 32 );
        my $client_ref_identifier = bin2dec( $client_ref_identifier_bi
+nary , 32 , "N" );

        my $client_ref_sec_epoc_b = substr( $rcv_sntp_packet , 128 , 3
+2 );
        my $client_ref_sec_epoc = bin2dec( $client_ref_sec_epoc_b , 32
+ , "N" );

        my $client_ref_microsec_epoc_b = substr( $rcv_sntp_packet , 16
+0 , 32 );
        my $client_ref_microsec_epoc = bin2dec( $client_ref_microsec_e
+poc_b , 32 , "N" );

        my $client_ref_epoc_d = $client_ref_sec_epoc . $dot . $client_
+ref_microsec_epoc;

        # Concatenate client ref sec and ref microsec for server messa
+ge transmission
        my $client_epoc_ref_b = $client_ref_sec_epoc_b . $client_ref_m
+icrosec_epoc_b;

        my $client_send_sec_epoc_b = substr( $rcv_sntp_packet , 192 , 
+32 );
        my $client_send_sec_epoc = bin2dec( $client_send_sec_epoc_b , 
+32 , "N" );

        my $client_send_microsec_epoc_b = substr( $rcv_sntp_packet , 2
+24 , 32 );
        my $client_send_microsec_epoc = bin2dec( $client_send_microsec
+_epoc_b , 32 , "N" );

        my $client_send_epoc_d = $client_send_sec_epoc . $dot . $clien
+t_send_microsec_epoc;
        
        # Concatenate client ref sec and ref microsec for server messa
+ge transmission
        my $client_epoc_send_b = $client_send_sec_epoc_b . $client_sen
+d_microsec_epoc_b;

        # Server data preparing message

        # Root Delay, total roundtrip delay to the primary reference s
+ource
        $server_rcv_epoc_microsec = $dot . $server_rcv_epoc_microsec;
        my $root_delay_server = $server_rcv_epoc_microsec - $client_ro
+ot_delay;

        if ($root_delay_server < 59) {
        $li_d = 0;
        } elsif ($root_delay_server == 61 ) {        
        $li_d = 1;        
        } elsif ($root_delay_server == 59) {        
        $li_d = 2;
        } else {
        $li_d = 3;
        }

        # $li = 0; is the server we have no warning for asynchronizati
+on
        my $li_b = dec2bin( $li_d , 8 , "c" );
        $li_b = substr $li_b, -2;

        # $vn = 3; is the version 3 only IPV4
        my $vn_b = dec2bin( 3 , 8 , "c" );
        $vn_b = substr $vn_b, -3;

        # $mode = 4; is the server (mode 4)
        my $mode_b = dec2bin( 4 , 8 , "c" );
        $mode_b = substr $mode_b, -3;

        # $stratum = 1; is the server clock which is primary reference
        my $stratum_b = dec2bin( 1 , 8 , "c" );

        # $poll = 6; # is the poll interval between messages 2**6 (2 t
+o the power of 6) = 64 sec
        my $poll_b = dec2bin( 2 , 8 , "c" );

        # The precission size on the RFC is 8 bits, anything lower tha
+n 1e-03 (0.001) it can not fit on 8 bits. In such cases we round to c
+lossest digit. Never the less the value is so small not even worth me
+ntioning it.
        #my ($realtime, $user, $system, $cuser, $csystem) = POSIX::tim
+es() ;
        
        ( undef , undef , $precision_server , undef , undef ) = POSIX:
+:times();
    
        my $precision_b = dec2bin( $precision_server , 8 , "c" );

        #my $root_delay_server = $server_rcv_epoc_d - $client_root_del
+ay;
        my $root_delay_server_b = dec2bin( $root_delay_server , 32 , "
+f" );

        my $root_dispersion = 0; # is the nominal error relative to th
+e primary reference since the server is the reference we can not have
+ relative error. We assume the source is accurate 100%.
        my $root_dispersion_b = dec2bin( $root_dispersion , 32 , "N" )
+;

        # $reference_identifier = 0; if this is the primary server the
+n there is not of offset LOCL or PPS if GPS
        my $reference_identifier_str = "LOCL";
        my $reference_identifier_b .= unpack( "B32" , $reference_ident
+ifier_str );

        # NTP uses 64-bit Time Stamps to exchange information. Two par
+ts are used, 32-bits for seconds and 32-bits for portions of a second
+. The 64-bit Time Stamp can manage 136 years of time based from Janua
+ry 1, 1970. Ref. http://www.linux.org/threads/tcp-ip-protocol-network
+-time-protocol-ntp.4912/
        # Server epoc receive packet from client in binary $server_epo
+c_rcv_b in decimal $server_rcv_epoc_d

        # Server epoc send in sec and microsec
        my ( $server_sec_send_d , $server_microsec_send_d ) = gettimeo
+fday();

        # Convert to binary epoc send seconds
        my $server_sec_send_b = dec2bin( $server_sec_send_d , 32 , "N"
+ );

        # Convert to binary epoc send micro seconds
        my $server_microsec_send_b = dec2bin( $server_microsec_send_d 
+, 32 , "N" );

        # Concatenate the epoc send sec and micro sec to a string 64 b
+its long to send
        my $server_epoc_send_b = $server_sec_send_b . $server_microsec
+_send_b;

        # Print decimal epoc send message
        my $server_epoc_send_d = $server_sec_send_d . $dot . $server_m
+icrosec_send_d;

        $send_sntp_packet = $li_b . $vn_b . $mode_b . $stratum_b . $po
+ll_b . $precision_b . $root_delay_server_b . $root_dispersion_b . $re
+ference_identifier_b . $client_epoc_ref_b . $client_epoc_send_b . $se
+rver_epoc_rcv_b . $server_epoc_send_b;

        $server_socket->send( $send_sntp_packet )
        or die "Server error send:  $!\n";
        
    } # End of else not Invalid Message

    #print "Send packet: ".$send_sntp_packet."\n";

    } # End of while(TRUE) loop

    $server_socket->close(); # Close socket

} # End of else arguments

sub dec2bin {
    my $bits      = shift;
    my $size      = shift;
    my $template  = shift;
    return unpack("B$size", pack($template, $bits));
}

sub bin2dec {
    my $bits     = shift;
    my $size     = shift;
    my $template = shift;
    return unpack($template, pack("B$size", substr("0" x $size . $bits
+ , -$size)));
}
[download]