Acme-AsciiArtinator
view release on metacpan or search on metacpan
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
my $fh;
next if !defined $Acme::AsciiArtinator::TestOutput[$ntest];
my $output = "";
if (defined $opts{"test_input$ntest"}) {
open($fh, ">", "ascii-art-test-$ntest-$$.stdin");
print $fh @test_stdin;
close $fh;
$output = qx{$^X "$OUTPUT" @test_argv < ascii-art-test-$ntest-$$.stdin};
unlink "ascii-art-test-$ntest-$$.stdin";
} else {
$output = qx{$^X "$OUTPUT" @test_argv};
}
print "Ran post-test # $ntest with argv: \"@test_argv\", stdin: \"@test_stdin\"\n";
if ($output eq $Acme::AsciiArtinator::TestOutput[$ntest]) {
print "Post-test # $ntest: PASS\n";
$Acme::AsciiArtinator::TestResult[$ntest] = "PASS";
} else {
print "Post-test # $ntest: FAIL\n";
$Acme::AsciiArtinator::TestResult[$ntest] = "FAIL";
print STDERR "-- " x 13, "\n";
print STDERR "Original results for test # $ntest:\n";
print STDERR "-- " x 7, "\n";
print STDERR $Acme::AsciiArtinator::TestOutput[$ntest];
print STDERR "\n", "-- " x 13, "\n";
print STDERR "Final results for test # $ntest:\n";
print STDERR $output;
print STDERR "\n", "-- " x 13, "\n\n";
}
} continue {
$ntest++;
}
return @output;
}
}
if ($ipad >= $max_tries) {
croak "The ASCII Artinator was unable to embed your code in the picture ",
"after $max_tries tries.\n";
}
}
#
# run a file containing Perl code for a Perl compilation check
#
sub compile_check {
my ($file) = @_;
print "\n";
print "- " x 20, "\n";
print "Compile check for $file:\n";
print "- " x 20, "\n";
print `$^X -cw "$file"`;
print "- " x 20, "\n";
return $?;
}
sub tweak_padding {
my ($filler, $tref, $cref) = @_;
# TODO: if there are many consecutive characters of padding
# in the code, we can improve its appearance by
# inserting some quoted text in void context.
}
#############################################################################
#
# code tokenization -- split code into tokens that should
# not be further divisible by whitespace
#
# You know that this [decompiling Perl code] is impossible, right ?
# http://www.perlmonks.org/index.pl?node_id=44722
my @token_keywords = qw(&&= ||= <<= >>= <=> ... **= //=
&& || ++ -- == != <= >= -> ** =~ !~
<= >= => .. += -= *= /= %= |= &= ^= << >> .= <> //);
# //= is an operator in perl 5.10, I believe
# // is usually a regular expression, or a perl 5.10 operator
my %sigil = qw($ 1 @ 2 % 3 & 4 & 0);
#
# does the current string begin with an "operator keyword"?
# if so, return it
#
sub find_token_keyword {
my ($q) = @_;
foreach my $k (@token_keywords) {
if (substr($q,0,length($k)) eq $k) {
return $k;
}
}
return;
}
#
# find position of a scalar in an array.
#
sub STRPOS {
my ($word, @array) = @_;
my $pos = -1;
for (my $i=0; $i<@array; $i++) {
$pos = $i if $array[$i] =~ /$word/;
}
return $pos;
}
#
# what does the "/" token that we just encountered mean?
# this is a hard game to play.
# see http://www.perlmonks.org/index.pl?node_id=44722
#
sub regex_or_divide {
my ($tokenref, $contextref) = @_;
my @tokens = @$tokenref;
my @contexts = @$contextref;
# regex is expected following an operator,
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
my $escaped = 0;
for(; $j <= $#INPUT; $j++) {
if ($INPUT[$j] eq "\\") {
$escaped = !$escaped;
next;
}
last if $INPUT[$j] eq $terminator && !$escaped;
# XXX - if regex has 'x' modifier,
# then
$escaped = 0;
}
push @tokens, "@INPUT[$i..$j]";
push @contexts, "regular expression A /$terminator/";
$i = $j;
} elsif (!$sigil && ($Q =~ /^s\W/ || $Q =~ /^y\W/ || $Q =~ /^tr\W/)) {
$j = $_ eq "t" ? $i + 3 : $i + 2;
my $terminator = $INPUT[$j-1];
$terminator =~ tr!{}<>[]{}()!}{><][}{)(!;
my $escaped = 0;
my $terminators_found = 0;
for (; $j <= $#INPUT; $j++) {
if ($INPUT[$j] eq "\\") {
$escaped = !$escaped;
next;
}
if ($INPUT[$j] eq $terminator && !$escaped) {
if ($terminators_found++) {
last;
}
}
$escaped = 0;
}
push @tokens, "@INPUT[$i..$j]";
push @contexts, "regular expression B /$terminator/";
$i = $j;
} elsif ($Q =~ /^[a-zA-Z_]\w*/) {
$token = $&;
# "T"x90 should be ["T",x,90] not ["T",x90]
# x90 should be x,90 when previous token is a scalar
if ($token =~ /^x\d+$/) {
if ($tokens[-1] =~ /^[\'\"]/ || $tokens[-1] eq ")"
|| $contexts[-1] =~ /name/) {
$token = "x";
}
}
push @tokens, $token;
if ($sigil) {
push @contexts, "name";
} elsif ($contexts[-1] =~ /regular expression ([ABC]) \/(.)\//) {
push @contexts, "regular expression modifier";
my $regex_type = $1;
my $terminator = $2;
# with some modifiers we can be more flexible with the earlier tokens ...
# e - second pattern is an expression that can be flexible
# x - first and/or second pattern can contain whitespace
if (0 && $token =~ /e/ && $token =~ /x/ && $tokens[-2] =~ /^s/) {
$DB::single=1;
pop @tokens;
pop @contexts;
my $regex = pop @tokens;
my $regex_context = pop @contexts;
my $terminator2 = $terminator;
$terminator2 =~ tr/])}>/[({</; # >})]
my $t1 = index($regex,$terminator2);
my $t2 = index($regex,$terminator,$t1+1);
push @tokens, substr($regex,0,$t1+1);
push @contexts, "regular expression x /$terminator/";
for (my $t=$t1+1; $t<=$t2; $t++) {
if (substr($regex,$t,1) =~ /\S/) {
push @tokens, substr($regex,$t,1);
push @contexts, "content of regex/x";
}
}
$i -= length($token) + length($regex) - $t2 - 1;
# positions $i to the start of the 2nd pattern,
# which can be tokenized as a perl expression.
# Hopefully the terminator can be recognized
} elsif ($token =~ /x/) {
pop @tokens;
pop @contexts;
my $regex = pop @tokens;
my $regex_context = pop @contexts;
my $terminator2 = $terminator;
$terminator2 =~ tr/])}>/[({</;
my $t1 = index($regex,$terminator2);
my $t2 = index($regex,$terminator,$t1+1);
push @tokens, substr($regex,0,$t1+1);
push @contexts, "regular expression x /$terminator/";
for (my $t=$t1+1; $t<=$t2; $t++) {
if (substr($regex,$t,1) =~ /\S/) {
push @tokens, substr($regex,$t,1);
push @contexts, "content of regex/x";
}
}
$i -= length($token) + length($regex) - $t2 - 1;
} elsif ($token =~ /e/ && $tokens[-2] =~ /^s/) {
if ($regex_type eq "B") { # s///, tr///, y///
pop @tokens;
pop @contexts;
my $regex = pop @tokens;
my $regex_context = pop @contexts;
my $terminator2 = $terminator;
$terminator2 =~ tr/])}>/[({</;
my $t1 = index($regex,$terminator2);
my $t2 = index($regex,$terminator,$t1+1);
push @tokens, substr($regex,0,$t2+1);
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
($B.$")x$_.$/}0..$N);@
o=(@o,($U.$F)x++$N.($"x3).($B.$U
)x$N.$/);;;;print@o;;;sub I{( $B,
$F, $P,$U)=qw(\\ /
| _);;}while($_=pop @o
){ y'/\\'\/';;;@o||y#_# #;; ;;;
;$ t++ ||y#_ # _#;print }# ##
## ## ################ ## ##
# ## ################ # #
# ## ################ ## #
# ## ############## ##
## ############ ##
## ######## ##
## ##
### ###
## ###
## ##
Hey, that was pretty cool! Let's see if it works.
$ echo 6 | perl spider-art.pl
\_______|_______/
/\______|______/\
/ /\_____|_____/\ \
/ / /\____|____/\ \ \
/ / / /\___|___/\ \ \ \
/ / / / /\__|__/\ \ \ \ \
/ / / / / /\_|_/\ \ \ \ \ \
_/_/_/_/_/_/_/ \_\_\_\_\_\_\_
\ \ \ \ \ \ \___/ / / / / / /
\ \ \ \ \ \/_|_\/ / / / / /
\ \ \ \ \/__|__\/ / / / /
\ \ \ \/___|___\/ / / /
\ \ \/____|____\/ / /
\ \/_____|_____\/ /
\/______|______\/
/ | \
=head1 UNDER THE HOOD
To fill in the shape of the spider, we inserted whitespace,
semi-colons, sharps, and maybe the occasional C<{> C<}> pair
into the original code. Certain blocks of text, like
C<print>, C<while>, and C<y#_ # _#> are kept intact since
splitting them would cause the program to either fail to
compile or to behave differently.
The ASCII Artinator tokenizes the code and
does its best to identify
=over 4
=item 1. Character strings that must not be divided
These include alphanumeric literals, quoted strings,
and most regular expressions.
=item 2. Places in the code where it is OK to insert padding.
=item 3. Places in the ASCII artwork where there are multiple
consecutive darkspace characters
=back
The next step is to try to align the tokens from the code
with enough contiguous blocks of darkspace in the art. When
a token is misaligned, we attempt to align it by inserting
some padding at some point in the code before that token.
There are currently two ways that we pad the code. Each
time there is a need to pad the code, we randomly choose
a padding method and randomly choose an eligible position
for padding.
=over 4
=item 1. Inserting semi-colons at the beginning or end of a statement
In general, we can put as many semi-colons as we like at the beginning
or end of statements. The following lines of code should all do the
same thing:
$a=$b+$c;$d=4
$a=$b+$c;;;;;;$d=4;;;;;;
;;;;;;;;;$a=$b+$c;;;;;;;;$d=4;
=item 2. Putting braces around a variable name.
In general, we can replace C<$name> with C<${name}> and the code
will run the same.
=back
There are several other interesting ways to pad code (putting parentheses
around expressions, adding and or-ing zeros to expressions, using quoted
strings in a void context) that may be put to use in future versions
of this module.
When all tokens from the code are successfully aligned with the
blocks of darkspace from the artwork, we can paste the code on top
of the art and write the output file.
Sometimes we insert too many characters without successfully
aligning the tokens and darkspace blocks (and actually in the
spider example, this happens about 90% of the time). If this
happens, we will start over and retry up to 100 times.
=head1 BEST PRACTICES
Certain coding practices will increase the chance that
C<Acme::AsciiArtinator> will be able to embed your code
in the artwork of your choice. In no particular order,
here are some suggestions:
=over 4
=item * Make sure the original code works
Make sure the code compiles and test it to see if it
works like you expect it to
before running the ASCII Artinator. It would be frustrating to
( run in 5.831 seconds using v1.01-cache-2.11-cpan-800906f7e73 )