Acme-Buckaroo
view release on metacpan or search on metacpan
Buckaroo.pm view on Meta::CPAN
# (and thus see lots of logging lines that explain how things are happening
# as they happen), set debug_mode = 1.
# If you do, you'll need either:
# (1) Perl 5.6 (to get Data::Dumper by default), or
# (2) to have Data::Dumper already installed.
# Data::Dumper is a very, very handy module, but it wasn't in the default Perl
# installation until (I think) Perl 5.6. Perl 5.005 usually don't have it.
# Look on CPAN.ORG for Data::Dumper if you don't have it.
###############################################################################
my $debug_mode = 0;
print("starting script...\n") if $debug_mode;
if ($debug_mode)
{
use Data::Dumper;
}
else
{
# sub Dumper { return(""); }
}
Buckaroo.pm view on Meta::CPAN
###############################################################################
sub translate
{
# receives the string of the entire perl script after 'use Acme::Buckaroo'.
my $in_string = shift;
my $out = "";
$out = Dumper($in_string);
print("Instring=>>$out<<\n") if $debug_mode;
my @in_array = split(//, $in_string);
$out = Dumper(@in_array);
print("in_array=>>$out<<\n") if $debug_mode;
my $i = 0;
my @temparray = ();
foreach my $thischar (@in_array)
{
# translate each character into it's ascii value.
my $num = unpack("c", $thischar);
# change that ascii value into a string from the array...
my $newchar = $xlate_array[$num];
print("char=>>$thischar<<, num=>>$num<<, newchar=>>$newchar<<\n") if $debug_mode;
print("char=>>%s<<, num=>>%s<<, newchar=>>%s<<\n", $thischar, $num, $newchar) if $debug_mode;
push(@temparray, "$newchar");
$i++;
if ($i > 3)
{
push(@temparray, "\n");
$i = 0;
}
}
my $out_string = $header . join("\t", @temparray) . "\n";
print("out_string=>>$out_string<<\n") if $debug_mode;
return $out_string;
}
################################################################################
# Normalize is called to convert the text to perl again from the encoded version.
#
sub normalize
{
my $in_string = shift;;
$in_string =~ s/^$header//g;
print("normalize, got in_string>>$in_string<<\n") if $debug_mode;
my %revhash = ();
my $counter = 0;
foreach my $this_elem (@xlate_array)
{
$revhash{$this_elem} = $counter++;
}
$in_string =~ s/\t\n/\t/g;
$in_string =~ s/\t+/\t/g;
my @in_array = split(/[\t]/, $in_string);
my $in_array_dump = Dumper(@in_array);
print("in_array_dump=>>$in_array_dump<<\n") if $debug_mode;
my @translate_array = ();
my $this_elem = "";
$counter = 1;
foreach $this_elem (@in_array)
{
if (!($this_elem)) { print("Found undefined elem, counter=$counter.\n"); $counter++; next; }
my $ascii_num = $xlate_2_hash{$this_elem} || 0;
my $to_char = pack("c", $ascii_num);
printf("Normalized >>%s<<, ascii_num=>>%s<<, char=>>%s<<, counter=>>%s<<\n", $this_elem, $ascii_num, $to_char, $counter) if $debug_mode;
push(@translate_array, $to_char);
$counter++;
}
my $outtext = join('', @translate_array);
print("Converted back to text=>>$outtext<<\n") if $debug_mode;
return("$outtext");
}
###############################################################################
sub has_wordchars
{
my $in_string = shift;
my $retval = 0;
print("In has_wordchars\n") if $debug_mode;
if ($in_string =~ /\s/)
{
return $in_string;
}
else
{
return 0;
}
}
###############################################################################
sub starts_with_header
{
my $in_string = shift;
my $retval = 0;
print("In starts_with_header\n") if $debug_mode;
if ($in_string =~ /^$header/)
{
return $in_string;
}
else
{
return 0;
}
}
###############################################################################
sub import
{
my $first = shift; # name of module, in this case "Buckaroo.pm"
my $source_filename = $0; # name of file called from (if test.pl does a 'use Acme::Buckaroo;' then this will be "test.pl")
print("Starting \"Buckaroo\" process...\n") if $debug_mode;
# set up some hashes to go to/from encoding scheme.
my $i = 0;
foreach my $this_elem (@xlate_array)
{
$xlate_2_hash{$this_elem} = $i;
$xlate_from_hash{$i} = $this_elem;
$i++;
}
if (!(open(FILE_HANDLE, "<$source_filename")))
{
print("Can't Buckaroo again on '$0'\n");
exit;
}
else
{
#comment this out if you don't care.
print("Past open... ") if $debug_mode;
}
#read entire file in as a string.
my @file_array = <FILE_HANDLE>;
my $file_array_dump = Dumper(@file_array);
print("file_array_dump=>>$file_array_dump<<") if $debug_mode;
my $file_string = join("", @file_array);
# elim anything before the 'use Acme::Buckaroo; line.
$file_string =~ s/use\s*Acme::Buckaroo\s*;\s*\n//;
print("Filestring=>>$file_string<<\n") if $debug_mode;
# no clue why we do this. Anyone know?
#local $SIG{__WARN__} = \&has_wordchars;
if ( (has_wordchars($file_string) ) &&
(!(starts_with_header($file_string))) )
{
if (!(open(FILE_HANDLE, ">$0")))
{
print("Cannot Buckaroo '$0'\n");
exit;
}
print("past open2...") if $debug_mode;
print(FILE_HANDLE "use Acme::Buckaroo;\n");
my $result = translate($file_string);
print(FILE_HANDLE $result);
print("Done \"Buckaroo-ing!\n");
}
else
{
print("normalizing...\n") if $debug_mode;
my $out_string = normalize($file_string);
print("out_string=>>$out_string<<\n") if $debug_mode;
my $outval = eval($out_string);
print("Outval returned: $outval\n") if $debug_mode;
if ($@)
{
print("Perl Error returned: $@\n");
}
print("No eval error returned.\n") if $debug_mode;
}
print("Finishing...\n") if $debug_mode;
exit;
}
###############################################################################
1;
###############################################################################
Buckaroo.pm view on Meta::CPAN
=head1 NAME
Acme::Buckaroo - Buckaroo Banzai Characters Infest Your Code!
=head1 SYNOPSIS
Before Buckaroo-ing:
use Acme::Buckaroo;
print "Watch 'Buckaroo Banzai Across the 8th Dimension' Today!";
After Bucaroo-ing:
use Acme::Buckaroo;
Buckaroo Banzai Across The Eigth Dimension Buckaroo Banzai Across The Eigth Dimension
Bari Dreiband-Burman General Catburd George Stokes Frank James Sparks
Gary Hellerstein Glenn Campbell Buckaroo Banzai Penny Priddy
Damon Hines New Jersey Glenn Campbell Doreen A. Dixon
Francine Lembi Buckaroo Banzai Girl Named John Scooter Lindley
Gordon Ecker Jr. Doreen A. Dixon Fred J. Koenekamp New Jersey
As someone who has taught beginners to use Perl, I've seen the problems
caused by using Perl idioms where typing a few more characters can make
maintenance possible and even quite easy.
SYNOPSIS
Before Buckaroo-ing:
use Acme::Buckaroo;
print "Watch 'Buckaroo Banzai Across the 8th Dimension' Today!";
After Bucaroo-ing:
use Acme::Buckaroo;
Buckaroo Banzai Across The Eigth Dimension Buckaroo Banzai Across The Eigth Dimension
Bari Dreiband-Burman General Catburd George Stokes Frank James Sparks
Gary Hellerstein Glenn Campbell Buckaroo Banzai Penny Priddy
Damon Hines New Jersey Glenn Campbell Doreen A. Dixon
Francine Lembi Buckaroo Banzai Girl Named John Scooter Lindley
Gordon Ecker Jr. Doreen A. Dixon Fred J. Koenekamp New Jersey
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test;
BEGIN { $| = 1; plan tests => 2 };
#use Acme::Buckaroo;
use Buckaroo;
ok(1); # If we made it this far, we're ok.
#########################
# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.
`rm -rf t`;
`mkdir t`;
`cd t`;
if (!(open(TFH, ">testscript.pl")))
{
print("not ok 1. Cannot Open Test testscript.pl for writing.");
}
print TFH <<END_OF_HEREDOC
#abcdefghijklmnopqrstuvwxyz
# ABCDEFGHIJKLMNOPQRSTUVWXYZ
#01234567890
#`~1!2@3#$4%%6^7&8*9(0)-_=+\|]]{{]};:"",<.>/?
print "Hello world\\n";
use strict;
BEGIN { unshift \@INC, `pwd` }
use Buckaroo;
# This test script should change so it contains only Buckaroo Banzai words.
# WARNING!! WARNING!! WARNING!! WARNING!!
# WARNING!! WARNING!! WARNING!! WARNING!!
# If you use this module, your source file will be converted into seeming junk
# Though it will still run normally.
# To fix it, go into the module Buckaroo.pm and set $debugmode = 1; and pipe the
# output to a new file. Remove the use Buckaroo.pm,
# and you're back the way you were.
# WARNING!! WARNING!! WARNING!! WARNING!!
# WARNING!! WARNING!! WARNING!! WARNING!!
# abcdefghijklmnopqrstuvwxyz
# ABCDEFGHIJKLMNOPQRSTUVWXYZ
# 01234567890
# `~1!2@3#$4%%6^7&8*9(0)-_=+\\|]]{{]};:"",<.>/?
print "Hello world\\n";
for (1..5)
{
print("Testing... ");
};
print("\\nabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRS\\n");
print("TUVWXYZ\\tabc 1234567890~!@\#$%^&*()_+-=}|{[]\;':\\",./<>?\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("\\nDone.\\n");
END_OF_HEREDOC
;
if (!(close(TFH)))
{
print("not ok 2. Cannot Close testscript.pl!");
}
my $retval = eval { `perl testscript.pl 2>&1 >> /dev/null` };
if (!(open(TFH2, "<testscript.pl")))
{
print("not ok 1. Cannot Open Test testscript.pl for writing.");
}
my @linearray = <TFH2>;
close(TFH2);
my $tfh_string = join("", @linearray);
my $compare_string = "";
if ($tfh_string eq $compare_string)
{
print "ok 2\n";
}
else
{
print "not ok 2\n";
}
1;
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test;
BEGIN { $| = 1; plan tests => 2 };
#use Acme::Buckaroo;
use Buckaroo;
ok(1); # If we made it this far, we're ok.
#########################
# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.
`rm -rf t`;
`mkdir t`;
`cd t`;
if (!(open(TFH, ">testscript.pl")))
{
print("not ok 1. Cannot Open Test testscript.pl for writing.");
}
print TFH <<END_OF_HEREDOC
#abcdefghijklmnopqrstuvwxyz
# ABCDEFGHIJKLMNOPQRSTUVWXYZ
#01234567890
#`~1!2@3#$4%%6^7&8*9(0)-_=+\|]]{{]};:"",<.>/?
print "Hello world\\n";
use strict;
BEGIN { unshift \@INC, `pwd` }
use Buckaroo;
# This test script should change so it contains only Buckaroo Banzai words.
# WARNING!! WARNING!! WARNING!! WARNING!!
# WARNING!! WARNING!! WARNING!! WARNING!!
# If you use this module, your source file will be converted into seeming junk
# Though it will still run normally.
# To fix it, go into the module Buckaroo.pm and set $debugmode = 1; and pipe the
# output to a new file. Remove the use Buckaroo.pm,
# and you're back the way you were.
# WARNING!! WARNING!! WARNING!! WARNING!!
# WARNING!! WARNING!! WARNING!! WARNING!!
# abcdefghijklmnopqrstuvwxyz
# ABCDEFGHIJKLMNOPQRSTUVWXYZ
# 01234567890
# `~1!2@3#$4%%6^7&8*9(0)-_=+\\|]]{{]};:"",<.>/?
print "Hello world\\n";
for (1..5)
{
print("Testing... ");
};
print("\\nabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRS\\n");
print("TUVWXYZ\\tabc 1234567890~!@\#$%^&*()_+-=}|{[]\;':\\",./<>?\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("alpha, beta, gamma, delta, epsilon zeta eta theta iota, lambda, mu, nu, xi omicron, phi, rho, sigma tau upsilon omega.\\n");
print("\\nDone.\\n");
END_OF_HEREDOC
;
if (!(close(TFH)))
{
print("not ok 2. Cannot Close testscript.pl!");
}
my $retval = eval { `perl testscript.pl 2>&1 >> /dev/null` };
if (!(open(TFH2, "<testscript.pl")))
{
print("not ok 1. Cannot Open Test testscript.pl for writing.");
}
my @linearray = <TFH2>;
close(TFH2);
my $tfh_string = join("", @linearray);
my $compare_string = "";
if ($tfh_string eq $compare_string)
{
print "ok 2\n";
}
# we're not running test 2 because I'm doing something wrong here.
# with the test, that is, not the module. Ug. gotta figure this out.
print "ok 2\n";
1;
( run in 1.514 second using v1.01-cache-2.11-cpan-de7293f3b23 )