Acme-EyeDrops
view release on metacpan or search on metacpan
- renamed function slurp_tfile() to _slurp_tfile()
- regenerated zgen.t (gen.t changed due to slurp_tfile() change)
(regenerated it with: perl -w -I lib t/gen.t generate)
- pod coverage: documented slurp_yerself()
- tests: improved the ugly test suite a little
new test: 16_astride.t simple threads test
new test: 17_Orange.t tests pod coverage
split 00_Coffee.t into two (last bit is now 15_Buffy.t)
added slurp_yerself() tests to 13_to.t
added Regex => 0 tests to 05_Parrot.t
exercise regex_binmode_print_sightly() in 05_Parrot.t
new tests added to 05_Parrot.t/06_not.t/10_Ponie.t et al
in response to gaping holes detected by Devel::Cover
removed exit 0 from end of tests
- documentation: added new Error Handling section
- Devel::Cover results: stmt branch cond sub pod total
95.2 91.3 90.8 100.0 100.0 93.5
1.46 Sat May 14 23:21:04 2005
- new shape: pugs
lib/Acme/EyeDrops.pm view on Meta::CPAN
package Acme::EyeDrops;
require 5.006;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT_OK);
require Exporter; @ISA = qw(Exporter);
@EXPORT_OK = qw(ascii_to_sightly sightly_to_ascii
regex_print_sightly regex_eval_sightly clean_print_sightly
clean_eval_sightly regex_binmode_print_sightly
clean_binmode_print_sightly
get_eye_dir get_eye_shapes get_eye_string get_builtin_shapes
get_eye_properties get_eye_keywords find_eye_shapes
make_triangle make_siertri make_banner
border_shape invert_shape reflect_shape rotate_shape
reduce_shape expand_shape hjoin_shapes
pour_text pour_sightly sightly);
$VERSION = '1.62';
{ # This table was generated by demo/gentable.pl.
my @C = (
q Z('!'^'!')Z,q Z('('^')')Z,q Z('<'^'>')Z,q Z('>'^'=')Z,
lib/Acme/EyeDrops.pm view on Meta::CPAN
map($C[$_], unpack('C*', sprintf('%x', $_)))), 128..255);
sub ascii_to_sightly { join '.', map($C[$_], unpack('C*', $_[0])) }
}
sub sightly_to_ascii { eval eval q#'"'.# . $_[0] . q#.'"'# }
sub regex_print_sightly {
q#''=~('('.'?'.'{'.# . ascii_to_sightly('print') . q#.'"'.# .
&ascii_to_sightly . q#.'"'.'}'.')')#;
}
sub regex_binmode_print_sightly {
q#''=~('('.'?'.'{'.# . ascii_to_sightly('binmode(STDOUT);print')
. q#.'"'.# . &ascii_to_sightly . q#.'"'.'}'.')')#;
}
sub regex_eval_sightly {
q#''=~('('.'?'.'{'.# . ascii_to_sightly('eval') . q#.'"'.# .
&ascii_to_sightly . q#.'"'.'}'.')')#;
}
sub clean_print_sightly {
qq#print eval '"'.\n\n\n# . &ascii_to_sightly . q#.'"'#;
}
sub clean_binmode_print_sightly {
qq#binmode(STDOUT);print eval '"'.\n\n\n# .
&ascii_to_sightly . q#.'"'#;
}
sub clean_eval_sightly {
qq#eval eval '"'.\n\n\n# . &ascii_to_sightly . q#.'"'#;
}
# -----------------------------------------------------------------
sub _slurp_tfile {
my $f = shift;
my $b = shift;
open my $fh, '<', $f or die "open '$f': $!";
$b and binmode($fh);
local $/; my $s = <$fh>; close($fh); $s;
}
# Poor man's properties (see also YAML, java.util.Properties).
# Return ref to property hash.
sub _get_properties {
my $f = shift;
open my $fh, '<', $f or die "open '$f': $!";
my $l; my %h;
while (defined($l = <$fh>)) {
lib/Acme/EyeDrops.pm view on Meta::CPAN
# Non-rigourous check for module (package) or END block.
@{$fill} or $fill = ($arg{SourceString} =~ /^\s*END\b/m or
$arg{SourceString} =~ /^\s*package\b/m) ?
[ '$:', '$~', '$^' ] :
[ '$:', '$~', '$^', '$/', '$,', '$\\' ];
}
$arg{RemoveNewlines} and $arg{SourceString} =~ tr/\n//d;
my $shape = my $sightly = "";
length($arg{SourceString}) && !$arg{Text} and $sightly = $arg{Print} ?
( $arg{Regex} ? ( $arg{Binary} ?
regex_binmode_print_sightly($arg{SourceString}) :
regex_print_sightly($arg{SourceString}) ) :
( $arg{Binary} ?
clean_binmode_print_sightly($arg{SourceString}) :
clean_print_sightly($arg{SourceString}) ) ) :
( $arg{Regex} ? regex_eval_sightly($arg{SourceString}) :
clean_eval_sightly($arg{SourceString}) );
if ($arg{ShapeString}) {
$shape = $arg{ShapeString};
} elsif ($arg{Shape}) {
$shape = join("\n" x $arg{Gap},
map(_get_builtin_string($_, \%arg) ||
(m#[./]# ? _slurp_tfile($_) : _get_eye_string($arg{EyeDir}, $_)),
split(/,/, $arg{Shape})));
lib/Acme/EyeDrops.pm view on Meta::CPAN
Given an ascii string STRING, returns a sightly-encoded Perl
program with a print statement executed via eval.
When run, the program will print STRING.
=item clean_eval_sightly STRING
Given a Perl program in ascii string STRING, returns an
equivalent sightly-encoded Perl program using an eval
statement executed via eval.
=item regex_binmode_print_sightly STRING
Given an ascii string STRING, returns a sightly-encoded Perl
program with a binmode(STDOUT) and a print statement embedded
in a regular expression. When run, the program will print STRING.
Note that STRING may contain any character in the range 0-255.
This function is used to sightly-encode binary files.
This function is dodgy because regexs don't seem to like
binary zeros; use C<clean_binmode_print_sightly> instead.
=item clean_binmode_print_sightly STRING
Given an ascii string STRING, returns a sightly-encoded Perl
program with a binmode(STDOUT) and a print statement executed
via eval. When run, the program will print STRING.
Note that STRING may contain any character in the range 0-255.
This function is used to sightly-encode binary files.
=item get_builtin_shapes
Returns a list of the built-in shape names.
=item get_eye_dir
t/05_Parrot.t view on Meta::CPAN
#!/usr/bin/perl
# 05_parrot.t (was sightly.t)
use strict;
use Acme::EyeDrops qw(sightly get_eye_string make_siertri make_triangle
regex_eval_sightly regex_binmode_print_sightly);
$|=1;
# --------------------------------------------------
sub build_file {
my ($f, $d) = @_;
local *F; open(F, '>'.$f) or die "open '$f': $!";
print F $d or die "write '$f': $!"; close(F);
}
t/05_Parrot.t view on Meta::CPAN
my $hellofile = 'helloworld.pl';
my $camelstr = get_eye_string('camel');
my $larrystr = get_eye_string('larry');
my $damianstr = get_eye_string('damian');
my $umlstr = get_eye_string('uml');
my $windowstr = get_eye_string('window');
my $japhstr = get_eye_string('japh');
my $yanick4str = get_eye_string('yanick4');
my $siertristr = make_siertri(5);
my $baldprogstr = regex_eval_sightly($hellostr);
# XXX: regex_binmode_print_sightly seems dodgy, this call is just to
# improve code coverage. Investigate later.
my $dodgyprogstr = regex_binmode_print_sightly($hellostr);
my $tmpf = 'bill.tmp';
my $tmpeye = 'tmpeye.eye';
my $tmpeye2 = 'tmpeye2.eye';
build_file($hellofile, $hellostr);
# --------------------------------------------------
my $itest = 0;
my $prog;
t/05_Parrot.t view on Meta::CPAN
$prog = sightly({ Shape => 'window',
SourceString => $srcstr,
Regex => 0,
InformHandler => sub {},
Print => 1 } );
test_one('Bill Gates is a pest!', $srcstr, $windowstr);
# Binary encode/decode -----------------------------
my $encodestr = qq#binmode(STDOUT);print eval '"'.\n\n\n#;
$encodestr =~ tr/!-~/#/;
$encodestr .= $camelstr x 5;
$srcstr = join("", map(chr(), 0..255));
$prog = sightly({ Shape => 'camel',
SourceString => $srcstr,
Binary => 1,
Regex => 0,
InformHandler => sub {},
Print => 1 } );
build_file($tmpf, $prog);
# This seems to stop on CTRL-Z on Windows!
# Something to do with binmode ??
# $outstr = `$^X -w -Mstrict $tmpf`;
# so use a temporary file instead.
my $tmpf2 = 'bill2.tmp';
system("$^X -Tw -Mstrict $tmpf >$tmpf2");
my $rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - binary str encode rc\n";
open(TT, $tmpf2) or die "open '$tmpf2': $!";
binmode(TT);
my $outstr = do { local $/; <TT> };
close(TT);
$outstr eq $srcstr or print "not ";
++$itest; print "ok $itest - binary str encode output\n";
$prog =~ tr/!-~/#/;
$prog eq $encodestr or print "not ";
++$itest; print "ok $itest - binary str encode shape\n";
$prog = sightly({ Shape => 'camel',
SourceFile => $tmpf2,
Binary => 1,
Regex => 0,
InformHandler => sub {},
Print => 1 } );
build_file($tmpf, $prog);
system("$^X -Tw -Mstrict $tmpf >$tmpf2");
$rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - binary file encode rc\n";
open(TT, $tmpf2) or die "open '$tmpf2': $!";
binmode(TT);
$outstr = do { local $/; <TT> };
close(TT);
$outstr eq $srcstr or print "not ";
++$itest; print "ok $itest - binary file encode output\n";
$prog =~ tr/!-~/#/;
$prog eq $encodestr or print "not ";
++$itest; print "ok $itest - binary file encode shape\n";
# Self-printing JAPH -------------------------------
( run in 0.301 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )