From 0aba6d99357d6866595ea05a044c272a62b35281 Mon Sep 17 00:00:00 2001 From: nwf Date: Sun, 10 Aug 2008 23:18:56 -0400 Subject: [PATCH] Mastercoder module for T and L encodings, soon messages proper darcs-hash:20080811031856-4d648-8eb2e3d6ad5e9f8d2a6fa3bbcf76a86614c867f0.gz --- code_test.pl | 26 ----------- code.pm => instance_1.pm | 16 +------ mastercode.pm | 98 ++++++++++++++++++++++++++++++++++++++++ mastercode_test.pl | 33 ++++++++++++++ 4 files changed, 132 insertions(+), 41 deletions(-) delete mode 100644 code_test.pl rename code.pm => instance_1.pm (90%) create mode 100644 mastercode.pm create mode 100644 mastercode_test.pl diff --git a/code_test.pl b/code_test.pl deleted file mode 100644 index e84aaac..0000000 --- a/code_test.pl +++ /dev/null @@ -1,26 +0,0 @@ -use warnings; - -# use Irssi::Scripts::Instance::Coder; ### XXX -use code; - -while (my $inst = <>) { - chomp $inst; - - my $enc = Irssi::Scripts::Instance::Coder::encode_instance($inst); - - unless (defined $enc) { - print "Unable to encode input.\n"; - next; - } - - my $dec = Irssi::Scripts::Instance::Coder::decode_instance($enc); - - print $inst.">>".$dec."(".(length $enc)."):"; - - foreach my $char (split(//, $enc)) { - printf " %2X", ord($char); - } - print "\n"; - - die unless ($inst eq $dec); -} diff --git a/code.pm b/instance_1.pm similarity index 90% rename from code.pm rename to instance_1.pm index 4807645..670fce9 100644 --- a/code.pm +++ b/instance_1.pm @@ -1,20 +1,6 @@ use warnings; -package Irssi::Scripts::Instance::Coder; - -# XXX Do we want to make any guarantees about the appearance of this delimiter -# in our encoded message? -my $MAGIC_DELIM = ""; -my $END_CODE = ""; - -################################################################# - -my @code_chars = ("", "", "", "", "", ""); - -my $i = 0; -foreach (@code_chars) { - $code_chars_rev{$_} = $i++; -} +#package Irssi::Scripts::Instance::Tagger1; ################################################################# diff --git a/mastercode.pm b/mastercode.pm new file mode 100644 index 0000000..2b76620 --- /dev/null +++ b/mastercode.pm @@ -0,0 +1,98 @@ +use warnings; +use strict; + +use Math::BaseCalc; +use POSIX qw( floor ); + +#package Irssi::Scripts::Instance::Mastercode; + +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +require Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw( + tencode tencode_padded tdecode lencode ldecode +); + +$VERSION = '0.0'; + +################################################################# + +my $MESSAGE_START = ""; +my $MESSAGE_END = ""; + +################################################################# + +#my @code_chars = ("", "", "", "", "", ""); + +# This version is lovely for visual debugging. +my @code_chars = ("B", "C", "G", "O", "V", "_"); +my %code_chars_rev; + +my $i = 0; +foreach (@code_chars) { + $code_chars_rev{$_} = $i++; +} + +my $code_chars_count = scalar @code_chars; + +################################################################# + +my $tencoder = new Math::BaseCalc(digits => \@code_chars); + +sub tencode ($) { $tencoder->to_base(@_); } +sub tdecode ($) { $tencoder->from_base(@_); } + +sub tencode_padded ($$) { + my $in = shift @_; + my $minpad = shift @_; + + my $tenc = tencode($in); + return $code_chars[0] + x ($minpad > length $tenc ? $minpad - length $tenc : 0) + . $tenc; +} + +sub lenc_body_len($) { + my $in = shift @_; + return 0 if $in == 0; + return floor( log(($code_chars_count-1)*$in + 1) / log($code_chars_count) ); +} + +sub lenc_correction($) { + my $enclen = shift @_; + return ( ($code_chars_count**($enclen) - 1) / ($code_chars_count-1) ); +} + +sub lencode ($) { + my $in = shift @_; + my $enclen = lenc_body_len($in); + + die "Can't encode numbers that big!" if $enclen >= $code_chars_count - 1; + + return tencode($enclen) if $in == 0; + + $in -= lenc_correction($enclen); + + return tencode($enclen) . tencode_padded($in, $enclen); +} + +sub ldecode($) { + my $in = shift @_; + + my $enclen = substr($in, 0, 1); + my $reallen = tdecode($enclen); + + die "Can't decode numbers that big!" if $reallen >= $code_chars_count - 1; + + my $encval = substr($in, 1, $reallen); + + my $realval = tdecode($encval); + $realval += lenc_correction($reallen); + + return ( $realval, $reallen+1 ) +} + +################################################################# + +1; diff --git a/mastercode_test.pl b/mastercode_test.pl new file mode 100644 index 0000000..d925ec2 --- /dev/null +++ b/mastercode_test.pl @@ -0,0 +1,33 @@ +use warnings; + +# use Irssi::Scripts::Instance::Mastercode; ### XXX +use mastercode qw(lencode ldecode tencode_padded tdecode); + +print "Checking T encoding machinery... \n"; + +foreach my $i (0 .. 35) { + my $enc = tencode_padded($i,2); + my $dec = tdecode($enc); + + print $i, " ", $enc, " ==> ", $dec, "\n" if $i % 10 == 0; + + die if length $enc != 2; + die if $dec != $i; +} + +print "Checking L encoding machinery... \n"; + +foreach my $i (0 .. 1554) { + my $enc = lencode($i); + my ($deci, $decsize) = ldecode($enc); + + print $i, " ", $enc, " (", length $enc, + ") ==> ", $deci, " (", $decsize, ")\n" + if $i % 100 == 0; + + die if $deci != $i; + die if $decsize != length $enc; + +} + + -- 2.50.1