Welcome to HBH! If you have tried to register and didn't get a verification email, please using the following link to resend the verification email.

Bincode coder/decoder - Perl Code Bank


Bincode coder/decoder
Encode value to bincode Decode bincode to value
                #!/usr/bin/perl

# Coded by Trizen under the GPL.
# Email: echo dHJpemVueEBnbWFpbC5jb20K | base64 -d
# Website: http://trizen.go.ro

use bigint;
use warnings;
use strict 'refs';

my @argv_nrs;
my @encoded_array;

my $opt_arg  = 0;
my $verbose  = 0;
my $decoding = 0;

foreach $_ (@ARGV) {
    if ( $_ =~ /^\d+$/ ) {
        push @argv_nrs, $_;
    }
    else {
        $opt_arg = 1;
    }
}
foreach $_ (@ARGV) {
    if (/^-+(?:h|help)$/) {
        print "
Usage: $0 [option] [value|binar]
\nOptions:
 -e, --encode
 -d, --decode
 -v, --verbose
\nExamples:
 $0 121
 $0 1111001 -d
\n";
        exit;
    }
    if (/^-+(?:v|verbose)$/) {
        $verbose = 1;
    }
    if (/^-+(?:d|decode)$/) {
        $decoding = 1;
    }
}
&_encode unless $decoding;
&_decode if $decoding;

sub _decode {
    use warnings;
    use strict 'refs';
    if ( $#argv_nrs < 0 ) {
        print "=>> Decode a value:\n> ";
        foreach $_ ( split( /\D/, <STDIN>, 0 ) ) {
            print decode($_) . "\n";
        }
    }
    else {
        foreach $_ (@argv_nrs) {
            print decode($_) . "\n";
        }
    }
}

sub _encode {
    use warnings;
    use strict 'refs';
    if ( $#argv_nrs < 0 ) {
        print "=>> Encode a value:\n> ";
        foreach $_ ( split( /\D/, <STDIN>, 0 ) ) {
            print encode($_) . "\n";
        }
    }
    else {
        foreach $_ (@argv_nrs) {
            print encode($_) . "\n";
        }
    }
}

sub decode {
    use warnings;
    use strict 'refs';
    my $code   = shift @_;
    my $length = length $code;
    print "\nDecoding: $code\nLength: "
      . $length . '-1 = '
      . ( $length - 1 ) . "\n\n"
      if $verbose;
    my (@binars) = split( //, $code, 0 );
    my ( @codes, $nr, $number, $binar_code );
    foreach $_ (@binars) {
        ++$length;
        if ($number) {
            $nr = $number - 1;
        }
        else {
            $nr = $length - 2;
        }
        $number = $nr;
        $binar_code += $_ * 2**$nr;
        print "$_ * 2^$nr = $binar_code\n" if $verbose;
    }
    print "\n" if $verbose;
    return $binar_code;
}

sub encode {
    use warnings;
    use strict 'refs';
    $#encoded_array = -1 unless $#_ == 1;
    my $nr = shift @_;
    return $nr if $nr =~ /^(?:0|1|)$/;
    my $nr1 = int $nr / 2;
    print "\n$nr\t= $nr1" if $verbose;
    my $nr2 = $nr1 * 2;
    my $nr3 = $nr - $nr2;
    print "\t * 2 \t+ $nr3" if $verbose;
    push @encoded_array, $nr3;

    if ( $nr1 != 1 ) {
        &encode( $nr1, 're-encode' );
    }
    my $bin = join( '', @encoded_array );
    $bin = 1 . reverse($bin);
    print "\n1\t= 0\t * 2 \t+ 1\n" if $verbose;
    return $bin;
}

            
Comments
Sorry but there are no comments to display