Acme-EyeDrops
view release on metacpan or search on metacpan
lib/Acme/EyeDrops.pm view on Meta::CPAN
my $f = shift;
open my $fh, '<', $f or die "open '$f': $!";
my $l; my %h;
while (defined($l = <$fh>)) {
chomp($l);
if ($l =~ s/\\$//) {
my $n = <$fh>; $n =~ s/^\s+//; $l .= $n;
redo unless eof($fh);
}
$l =~ s/^\s+//; $l =~ s/\s+$//;
next unless length($l);
next if $l =~ /^#/;
my ($k, $v) = split(/\s*:\s*/, $l, 2);
$h{$k} = $v;
}
close($fh);
return \%h;
}
sub _def_ihandler { print STDERR $_[0] }
# Return largest no. of tokens with total length less than $slen ($slen > 0).
sub _guess_ntok {
my ($rtok, $sidx, $slen, $rexact) = @_; my $tlen = 0;
for my $i ($sidx .. $sidx + $slen) {
($tlen += length($rtok->[$i])) < $slen or
return $i - $sidx + (${$rexact} = $tlen == $slen);
}
# should never get here
}
sub _guess_compact_ntok {
my ($rtok, $sidx, $slen, $rexact, $fcompact) = @_; my $tlen = 0;
for my $i ($sidx .. $sidx + $slen + $slen) {
($tlen += length($rtok->[$i]) - ($i > $sidx+1 && $rtok->[$i-1] eq '.'
&& substr($rtok->[$i], 0, 1) eq "'" && substr($rtok->[$i-2], 0, 1)
eq "'" ? (${$fcompact} = 3) : 0)) < $slen or
return $i - $sidx + ($tlen > $slen ? 0 : (${$rexact} = 1) +
($i > $sidx && $rtok->[$i] eq '.' && substr($rtok->[$i-1], 0, 1)
eq "'" && $rtok->[$i+1] =~ /^'..$/ ? (${$fcompact} = 1) : 0));
}
# should never get here
}
sub _compact_join {
lib/Acme/EyeDrops.pm view on Meta::CPAN
eq "'" && substr($rtok->[$i-2], 0, 1) eq "'") {
substr($s, -2) = substr($rtok->[$i], 1); # 'a'.'b' to 'ab'
} else {
$s .= $rtok->[$i];
}
}
$s;
}
# Pour $n tokens from @{$rtok} (starting at index $sidx) into string
# of length $slen. Return string or undef if unsuccessful.
sub _pour_chunk {
my ($rtok, $sidx, $n, $slen) = @_;
my $eidx = $sidx + $n - 1; my $tlen = 0;
my $idot = my $iquote = my $i3quote = my $iparen = my $idollar = -1;
for my $i ($sidx .. $eidx) {
$tlen += length($rtok->[$i]);
if ($rtok->[$i] eq '.') { $idot = $i }
elsif ($rtok->[$i] eq '(') { $iparen = $i }
elsif (substr($rtok->[$i], 0, 1) eq '$') { $idollar = $i }
elsif ($rtok->[$i] =~ /^['"]/) {
$iquote = $i; $i3quote = $i if length($rtok->[$i]) == 3;
}
}
die "oops" if $tlen >= $slen;
my $i2 = (my $d = $slen - $tlen) >> 1;
$idot >= 0 && !($d%3) and return join("", @{$rtok}[$sidx .. $idot-1],
".''" x int($d/3), @{$rtok}[$idot .. $eidx]);
if (!($d&1) and $iquote >= 0 || $idollar >= 0) {
$iquote = $idollar if $iquote < 0;
return join("", @{$rtok}[$sidx .. $iquote-1], '(' x $i2 .
$rtok->[$iquote] . ')' x $i2, @{$rtok}[$iquote+1 .. $eidx]);
lib/Acme/EyeDrops.pm view on Meta::CPAN
}
}
push(@mytok, $rtok->[$sidx+$n]); # _pour_chunk checks next token
_pour_chunk(\@mytok, 0, $#mytok, $slen);
}
# Pour unsightly text $txt into shape defined by string $tlines.
sub pour_text {
my ($tlines, $txt, $gap, $tfill) = @_;
$txt =~ s/\s+//g;
my $ttlen = 0; my $txtend = length($txt);
my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
split(/\n/, $tlines));
for my $r (grep($_, @tnlines)) {
for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
}
my $nshape = int($txtend/$ttlen); my $rem = $txtend % $ttlen;
if ($rem || !$nshape) {
++$nshape;
$txt .= $tfill x (int(($ttlen-$rem)/length($tfill))+1)
if length($tfill);
}
my $s = ""; my $p = 0;
for (my $n = 1; 1; ++$n, $s .= "\n" x $gap) {
for my $r (@tnlines) {
if ($r) {
for my $i (0 .. $#{$r}) {
if ($i & 1) {
$s .= substr($txt, $p, $r->[$i]); $p += $r->[$i];
return "$s\n" if !length($tfill) && $p >= $txtend;
} else {
$s .= ' ' x $r->[$i];
}
}
}
$s .= "\n";
}
last if $n >= $nshape;
}
$s;
lib/Acme/EyeDrops.pm view on Meta::CPAN
$rem and splice(@filleqto, -$rem);
my $v = -1;
map(($fv->[++$v % $nfv], '=', @{$_}, ';'), @filleqto);
}
# Pour sightly program $prog into shape defined by string $tlines.
sub pour_sightly {
my ($tlines, $prog, $gap, $fillv, $compact, $ihandler) = @_;
$ihandler ||= \&_def_ihandler;
my $ttlen = 0;
my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
split(/\n/, $tlines));
for my $r (grep($_, @tnlines)) {
for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
}
my $outstr = ""; my @ptok;
if ($prog) {
if ($prog =~ /^''=~/g) {
push(@ptok, ($tlines =~ /(\S+)/ ? length($1) : 0) == 3 ?
"'?'" : "''", '=~');
} elsif ($prog =~ /(.*eval.*\n\n\n)/g) {
$outstr .= $1;
}
push(@ptok, $prog =~ /[().&|^]|'\\\\'|.../g); # ... is "'"|'.'
}
my $iendprog = @ptok;
my @filler = _make_filler(ref($fillv) ? $fillv : [ '$:', '$~', '$^' ]);
# Note: 11 is the length of a filler item, for example, $:='.'^'~';
# And there are 6 tokens in each filler item: $: = '.' ^ '~' ;
push(@ptok, 'Z', (@filler) x (int($ttlen/(11 * int(@filler / 6))) + 1));
my $sidx = 0;
for (my $nshape = 1; 1; ++$nshape, $outstr .= "\n" x $gap) {
for my $rline (@tnlines) {
unless ($rline) { $outstr .= "\n"; next }
for my $it (0 .. $#{$rline}) {
unless ($it & 1) {$outstr .= ' ' x $rline->[$it]; next }
(my $tlen = $rline->[$it]) == (my $plen = length($ptok[$sidx]))
and $outstr .= $ptok[$sidx++], next;
if ($plen > $tlen) {
$outstr .= '(' x $tlen;
splice(@ptok, $sidx+1, 0, (')') x $tlen);
$iendprog += $tlen if $sidx < $iendprog;
next;
}
my $fcompact = my $fexact = 0;
my $n = $compact ?
_guess_compact_ntok(\@ptok, $sidx, $tlen, \$fexact, \$fcompact)
lib/Acme/EyeDrops.pm view on Meta::CPAN
if ($fexact) {
$outstr .= $fcompact ? _compact_join(\@ptok, $sidx, $n) :
join("", @ptok[$sidx .. $sidx+$n-1]);
$sidx += $n; next;
}
my $str;
--$n while $n > 0 && !defined($str = $fcompact ?
_pour_compact_chunk(\@ptok, $sidx, $n, $tlen) :
_pour_chunk(\@ptok, $sidx, $n, $tlen));
if ($n) { $outstr .= $str; $sidx += $n; next }
++$n while $n < $tlen && length($ptok[$sidx+$n]) < 2;
die "oops ($n >= $tlen)" if $n >= $tlen;
$outstr .= join("", @ptok[$sidx .. $sidx+$n-1]);
$sidx += $n;
$outstr .= '(' x (my $nleft = $tlen - $n);
splice(@ptok, $sidx+1, 0, (')') x $nleft);
$iendprog += $nleft if $sidx < $iendprog;
}
$outstr .= "\n";
}
$ihandler->("$nshape shapes completed.\n");
last if $sidx >= $iendprog;
}
my $eidx = rindex($outstr, 'Z');
substr($outstr, $eidx, 1) = ';' if $eidx >= 0;
return $outstr if $sidx == $iendprog || $sidx == $iendprog+1;
die "oops" if $eidx < 0;
ref($fillv) or return substr($outstr, 0, $eidx) . (length($fillv) ?
pour_text(substr($outstr, $eidx), "", 0, $fillv) : "\n");
(my $idx = rindex($outstr, ';')) >= 0 or return $outstr;
my @t = substr($outstr, $idx+1) =~
/[()&|^=;]|\$.|'[^'\\]*(?:\\.[^'\\]*)*'|"[^"\\]*(?:\\.[^"\\]*)*"/g
or return $outstr;
my $nl = my $nr = my $ne = 0;
for my $c (@t) {
if ($c eq '(') {++$nl} elsif ($c eq ')') {++$nr}
elsif ($c eq '=') {++$ne}
}
if ($ne == 0 || $nl != $nr || $t[-1] eq '=') {
my $f = ';'; # Trouble: wipe out last bit with filler
for my $i ($idx+1 .. length($outstr)-2) {
substr($outstr, $i, 1) =~ tr/ \n// or
substr($outstr, $i, 1) = $f = $f eq '#' ? ';' : '#';
}
} elsif ($t[-1] eq '|' or $t[-1] eq '^' or $t[-1] eq '&') {
$outstr =~ s/\S(\s*)$/;$1/;
}
$outstr;
}
# -----------------------------------------------------------------
lib/Acme/EyeDrops.pm view on Meta::CPAN
sub _border {
my ($a, $w, $c, $l, $r, $t, $b) = @_;
my $z = $c x ($w+$l+$r); my $f = $c x $l; my $g = $c x $r;
for (@{$a}) { $_ = $f . $_ . $g }
unshift(@{$a}, ($z) x $t); push(@{$a}, ($z) x $b);
}
sub border_shape {
my ($tlines, $gl, $gr, $gt, $gb, $wl, $wr, $wt, $wb) = @_;
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
for my $l (@a) { $m = length($l) if length($l) > $m }
for my $l (@a) { $l .= ' ' x ($m - length($l)) }
$gl || $gr || $gt || $gb and _border(\@a, $m, ' ', $gl, $gr, $gt, $gb);
$wl || $wr || $wt || $wb and _border(\@a, $m+$gl+$gr,'#',$wl,$wr,$wt,$wb);
join("\n", @a, "");
}
sub invert_shape {
my $tlines = shift;
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
for my $l (@a) { $m = length($l) if length($l) > $m }
for my $l (@a) { $l .= ' ' x ($m - length($l)) }
my $s = join("\n", @a, ""); $s =~ tr/ #/# /;
$s =~ s/ +$//mg; $s;
}
sub reflect_shape {
my $tlines = shift;
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
for my $l (@a) { $m = length($l) if length($l) > $m }
my $s = join("\n", map(scalar reverse($_ . ' ' x ($m - length)), @a), "");
$s =~ s/ +$//mg; $s;
}
sub hjoin_shapes {
my ($g, @shapes) = @_;
my $ml = 0; my @lines;
for my $s (@shapes) { my $n = $s =~ tr/\n//; $ml = $n if $n > $ml }
for my $tlines (@shapes) {
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
for my $l (@a) { $m = length($l) if length($l) > $m }
for my $l (@a) { $l .= ' ' x ($m - length($l) + $g) }
push(@a, (' ' x ($m + $g)) x ($ml - @a));
for my $i (0..$#a) { $lines[$i] .= $a[$i] }
}
my $s = join("\n", @lines, "");
$s =~ s/ +$//mg; $s;
}
sub reduce_shape {
my ($tlines, $f) = @_; my $i = $f++; my $s = "";
for my $l (grep(!(++$i%$f), split(/\n/, $tlines))) {
for ($i = 0; $i < length($l); $i += $f) { $s .= substr($l, $i, 1) }
$s .= "\n";
}
$s =~ s/ +$//mg; $s;
}
sub expand_shape {
my ($s, $f) = @_; my $i = ' ' x ++$f; my $j = '#' x $f;
$s =~ s/ /$i/g; $s =~ s/#/$j/g; my $t = "";
for my $l (split(/^/, $s, -1)) { $t .= $l x $f } $t;
}
# Rotate shape clockwise: 90, 180 or 270 degrees
# (other angles are left as an exercise for the reader:-)
sub rotate_shape {
my ($tlines, $degrees, $rtype, $flip) = @_;
$degrees == 180 and
return join("\n", reverse(split(/\n/, $tlines)), "");
my $t = $rtype==0 ? 2 : 1; my $inc = $rtype==1 ? 2 : 1;
my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0; my $s = "";
for my $l (@a) { $m = length($l) if length($l) > $m }
for my $l (@a) { $l .= ' ' x ($m - length($l)) }
if ($degrees == 90) {
@a = reverse(@a) unless $flip;
for (my $i = 0; $i < $m; $i += $inc) {
for (@a) {$s .= substr($_, $i, 1) x $t} $s .= "\n"
}
} elsif ($degrees == 270) {
@a = reverse(@a) if $flip;
for (my $i = $m-1; $i >= 0; $i -= $inc) {
for (@a) {$s .= substr($_, $i, 1) x $t} $s .= "\n"
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
my ($w, $src) = @_;
# Linux /usr/games/banner can be used.
# CPAN Text::Banner will hopefully be enhanced so it can be used too.
my $b_exe = '/usr/games/banner';
-x $b_exe or die "'$b_exe' not available on this platform.";
my $f = $w ? "-w $w" : ""; $src =~ s/\s+/ /g; $src =~ s/ $//;
# Following characters not in /usr/games/banner character set:
# \ [ ] { } < > ^ _ | ~
# Also must escape ' from the shell.
$src =~ tr#_\\[]{}<>^|~'`#-/()()()H!T""#;
my $s = ""; my $len = length($src);
for (my $i = 0; $i < $len; $i += 512) {
my $cmd = "$b_exe $f '" . substr($src, $i, 512) . "'";
$s .= `$cmd`; my $rc = $? >> 8; $rc and die "<$cmd>: rc=$rc";
}
$s =~ s/\s+$/\n/; $s =~ s/ +$//mg;
# Remove as many leading spaces as possible.
my $m = 32000; # regex /^ {$m}/ blows up if $m > 32766
while ($s =~ /^( *)\S/mg) { $m = length($1) if length($1) < $m }
$s =~ s/^ {$m}//mg if $m; $s;
}
# -------------------------------------------------------------------------
sub _bi_all {
join "\n" x $_[0]->{Width},
map(_get_eye_string($_[0]->{EyeDir}, $_), _get_eye_shapes($_[0]->{EyeDir}))
}
sub _bi_triangle { make_triangle($_[0]->{Width}) }
lib/Acme/EyeDrops.pm view on Meta::CPAN
BorderWidth => 0, BorderWidthLeft => 0,
BorderWidthRight => 0, BorderWidthTop => 0,
BorderWidthBottom => 0, TrapEvalDie => 0,
TrapWarn => 0, FillerVar => [],
EyeDir => get_eye_dir()
);
for my $k (keys %{$ruarg}) {
exists($arg{$k}) or die "invalid parameter '$k'";
$arg{$k} = $ruarg->{$k};
}
length($arg{SourceFile}) && $arg{SourceHandle} and
die "cannot specify both SourceFile and SourceHandle";
length($arg{SourceFile}) && length($arg{SourceString}) and
die "cannot specify both SourceFile and SourceString";
length($arg{SourceString}) && $arg{SourceHandle} and
die "cannot specify both SourceString and SourceHandle";
$arg{Shape} && $arg{ShapeString} and
die "cannot specify both Shape and ShapeString";
if (length($arg{SourceFile})) {
$arg{SourceString} = _slurp_tfile($arg{SourceFile}, $arg{Binary});
} elsif ($arg{SourceHandle}) {
local $/; $arg{SourceString} = readline($arg{SourceHandle});
}
my $fill = $arg{FillerVar};
if (ref($fill) && !$arg{Text}) {
# 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};
lib/Acme/EyeDrops.pm view on Meta::CPAN
Reduce Reduce the size of the shape.
Expand Expand the size of the shape.
Invert Boolean. Invert the shape.
Indent Indent the shape. The number of spaces to indent.
TrailingSpaces Boolean. Ensure all lines of the shape are of equal
length, adding trailing spaces if required.
RemoveNewlines Boolean. Remove all newlines from the source before
conversion.
BorderGap Put a border around the shape. Gap between border
and the shape.
BorderGapLeft,BorderGapRight,BorderGapTop,BorderGapBottom
You can override BorderGap with one or more from
the above.
t/03_Larry.t view on Meta::CPAN
++$itest; print "ok $itest - $e nlf $enlf\n";
$last = chop($prog);
$last eq "\n" or print "not ";
++$itest; print "ok $itest - $e last is newline\n";
}
# --------------------------------------------------
my $srcstr = qq#print "abc\\n";\n#;
my $sightlystr = regex_eval_sightly($srcstr);
length($sightlystr) == $exact or print "not ";
++$itest; print "ok $itest - exact 215\n";
# Exact fit abc ------------------------------------
$prog = sightly({ Width => $exact,
SourceString => $srcstr,
InformHandler => sub {},
Regex => 1 } );
test_one('Exact fit abc', "abc\n", 1);
length($prog) == $exact or print "not ";
++$itest; print "ok $itest\n";
$prog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
$last = chop($prog);
$last eq ')' or print "not ";
++$itest; print "ok $itest\n";
# One more abc ------------------------------------
$prog = sightly({ Width => $exact+1,
SourceString => $srcstr,
InformHandler => sub {},
Regex => 1 } );
test_one('One more abc', "abc\n", 1);
length($prog) == $exact+1 or print "not ";
++$itest; print "ok $itest\n";
$last = chop($prog);
$last eq ';' or print "not ";
++$itest; print "ok $itest\n";
$prog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
# One less abc ------------------------------------
$prog = sightly({ Width => $exact-1,
SourceString => $srcstr,
InformHandler => sub {},
Regex => 1 } );
test_one('One less abc', "abc\n", 2);
my @lines = split(/^/, $prog, -1); chop(@lines);
scalar(@lines) == 2 or print "not ";
++$itest; print "ok $itest\n";
my $fchar = substr($lines[1], 0, 1);
$fchar eq ')' or print "not ";
++$itest; print "ok $itest\n";
length($prog) == 2*($exact-1)+1 or print "not ";
++$itest; print "ok $itest\n";
my $nprog = $lines[0] . $fchar;
$nprog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
# --------------------------------------------------
# Test with FillerVar = '#'
# Exact fit abc ------------------------------------
$prog = sightly({ Width => $exact,
SourceString => $srcstr,
FillerVar => '#',
InformHandler => sub {},
Regex => 1 } );
test_one('Exact fit abc, FillerVar=#', "abc\n", 1);
length($prog) == $exact or print "not ";
++$itest; print "ok $itest\n";
$prog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
$last = chop($prog);
$last eq ')' or print "not ";
++$itest; print "ok $itest\n";
# One more abc ------------------------------------
$prog = sightly({ Width => $exact+1,
SourceString => $srcstr,
FillerVar => '#',
InformHandler => sub {},
Regex => 1 } );
test_one('One more abc, FillerVar=#', "abc\n", 1);
length($prog) == $exact+1 or print "not ";
++$itest; print "ok $itest\n";
$last = chop($prog);
$last eq ';' or print "not ";
++$itest; print "ok $itest\n";
$prog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
# One less abc ------------------------------------
$prog = sightly({ Width => $exact-1,
t/03_Larry.t view on Meta::CPAN
FillerVar => '#',
InformHandler => sub {},
Regex => 1 } );
test_one('One less abc, FillerVar=#', "abc\n", 2);
@lines = split(/^/, $prog, -1); chop(@lines);
scalar(@lines) == 2 or print "not ";
++$itest; print "ok $itest\n";
$fchar = substr($lines[1], 0, 1);
$fchar eq ')' or print "not ";
++$itest; print "ok $itest\n";
length($prog) == 2*($exact-1)+1 or print "not ";
++$itest; print "ok $itest\n";
$nprog = $lines[0] . $fchar;
$nprog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
# --------------------------------------------------
unlink($tmpf) or die "error: unlink '$tmpf': $!";
t/05_Parrot.t view on Meta::CPAN
InformHandler => sub {},
Regex => 1 } );
build_file($tmpf, $prog);
$outstr = `$^X -Tw -Mstrict $tmpf`;
$rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - Camel helloworld fillervar= rc\n";
$outstr eq "hello world\n" or print "not ";
++$itest; print "ok $itest - Camel helloworld fillervar= output\n";
$prog =~ s/^use re 'eval';\n// if $] >= 5.017; # remove leading use re 'eval' line
length($prog) eq 472 or print "not ";
++$itest; print "ok $itest - Camel helloworld fillervar= length\n";
# Yanick4 hellotest.pl -----------------(3 shapes)--
$prog = sightly({ Shape => 'yanick4',
SourceString => $helloteststr,
InformHandler => sub {},
Regex => 1 } );
test_one('Yanick4 hellotest',
"hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
$yanick4str x 3);
t/10_Ponie.t view on Meta::CPAN
my $snowflake = pour_text($snow, "", 1, '#');
$snowflake eq $snow or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$snowflake = pour_text($snow, $src, 1, "");
my $t = $snowflake; $t =~ s/\s+//g;
my $v = $src; $v =~ s/\s+//g;
substr($t, 0, length($v)) eq $v or print "not ";
++$itest; print "ok $itest\n";
substr($t, length($v)) eq '' or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$snowflake = pour_text($snow, $src, 1, '#');
$t = $snowflake;
$t =~ tr/!-~/#/;
$t eq $snow or print "not ";
++$itest; print "ok $itest\n";
$t = $snowflake; $t =~ s/\s+//g;
$v = $src; $v =~ s/\s+//g;
substr($t, 0, length($v)) eq $v or print "not ";
++$itest; print "ok $itest\n";
substr($t, length($v)) eq '#' x (length($t)-length($v)) or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
$snowflake = sightly( { Shape => 'snow',
SourceString => $src,
Text => 1,
TextFiller => '#' } );
$t = $snowflake;
$t =~ tr/!-~/#/;
$t eq $snow or print "not ";
++$itest; print "ok $itest\n";
$t = $snowflake; $t =~ s/\s+//g;
$v = $src; $v =~ s/\s+//g;
substr($t, 0, length($v)) eq $v or print "not ";
++$itest; print "ok $itest\n";
substr($t, length($v)) eq '#' x (length($t)-length($v)) or print "not ";
++$itest; print "ok $itest\n";
# -------------------------------------------------
my $shape = "## ###\n";
my $p = pour_text($shape, "", 1, "");
$p eq "\n" or print "not ";
++$itest; print "ok $itest\n";
$p = pour_text($shape, 'X', 1, "");
$p eq "X\n" or print "not ";
# --------------------------------------------------
my $itest = 0;
# --------------------------------------------------
# Test _make_filler()
{
my $fillv = '#';
# This line is used in A::E pour_sightly().
# Note: 11 is the length of, for example, $:='.'^'~';
# Multiple of 6 because each filler contains 6 tokens:
# $: = '.' ^ '~' ;
# Also, no single quoted string should contain " or ;
# Oh, and $; variable is banned.
# XXX: add tests for all these later.
my @filler = Acme::EyeDrops::_make_filler(
ref($fillv) ? $fillv : [ '$:', '$~', '$^' ]);
my $nfiller = @filler;
$nfiller == 72 or print "not ";
++$itest; print "ok $itest - _make_filler 72 items (got $nfiller)\n";
sub _get_eyp_shapes {
my $d = shift; local *D;
opendir(D, $d) or die "opendir '$d': $!";
my @e = sort map(/(.+)\.eyp$/, readdir(D)); closedir(D); @e;
}
# -----------------------------------------------------------------------
# slurp_yerself() tests (primitive)
my $eyedrops_pm = Acme::EyeDrops::slurp_yerself();
my $elen = length($eyedrops_pm);
$elen > 50000 or print "not ";
++$itest; print "ok $itest - slurp_yerself length is $elen\n";
my $nlines = $eyedrops_pm =~ tr/\n//;
$nlines > 1000 or print "not ";
++$itest; print "ok $itest - slurp_yerself line count is $nlines\n";
# XXX: could add MD5 checksum test here.
# XXX: beware above test is fragile when testing auto-generated EyeDrops.pm
# (as is done by 19_surrounds.t)
# -----------------------------------------------------------------------
# get_eye_dir() tests.
( run in 0.530 second using v1.01-cache-2.11-cpan-65fba6d93b7 )