Acme-EyeDrops

 view release on metacpan or  search on metacpan

lib/Acme/EyeDrops.pm  view on Meta::CPAN

   'local $SIG{__WARN__}=sub{};' x $arg{TrapWarn} .
   pour_sightly($shape, $sightly, $arg{Gap}, $fill, $arg{Compact},
   $arg{InformHandler}) . "\n\n\n;die \$\@ if \$\@\n" x $arg{TrapEvalDie};
}

# -------------------------------------------------------------------------

sub _get_eye_shapes {
   my $d = shift;
   opendir my $dh, $d or die "opendir '$d': $!";
   my @e = sort map(/(.+)\.eye$/, readdir($dh));
   closedir($dh); @e;
}

sub _get_eye_string { _slurp_tfile($_[0] . '/' . $_[1] . '.eye') }

sub _get_eye_properties {
   my $f = $_[0] . '/' . $_[1] . '.eyp';
   -f $f or return;
   _get_properties($f);
}

sub _get_eye_keywords {
   my $d = shift;
   my %h;
   SHAPE: for my $s (_get_eye_shapes($d)) {
      my $p = _get_eye_properties($d, $s) or next SHAPE;  # no properties
      exists($p->{keywords})              or next SHAPE;  # no keywords property
      my @k = split(" ", $p->{keywords})  or next SHAPE;  # no keywords
      for my $k (@k) { push(@{$h{$k}}, $s) }
   }
   return \%h;
}

sub _find_eye_shapes {
   my $d = shift;
   @_ or die "oops, no keywords given";
   my @skey = map([split/\s+OR\s+/], @_);
   my @ret;
   SHAPE: for my $s (_get_eye_shapes($d)) {
      my $p = _get_eye_properties($d, $s) or next SHAPE;  # no properties
      exists($p->{keywords})              or next SHAPE;  # no keywords property
      my @k = split(" ", $p->{keywords})  or next SHAPE;  # no keywords
      my %h; @h{@k} = ();
      for my $k (@skey) {
         # XXX: short-circuiting List::Util::first() better than grep here.
         grep(exists($h{$_}), @{$k}) or next SHAPE;  # AND, all must be true
      }
      push(@ret, $s);
   }
   return @ret;
}

sub get_eye_shapes     { _get_eye_shapes(get_eye_dir()) }
sub get_eye_string     { _get_eye_string(get_eye_dir(), shift) }
sub get_eye_properties { _get_eye_properties(get_eye_dir(), shift) }
sub get_eye_keywords   { _get_eye_keywords(get_eye_dir()) }
sub find_eye_shapes    { _find_eye_shapes(get_eye_dir(), @_) }

# $eye_dir is the directory containing the .eye file shapes.
# Note: $eye_dir is only eval-hostile line in EyeDrops.pm; do not change it
# for t/19_surrounds.t and "EyeDropping EyeDrops.pm" section of doco relies
# on it. Remove ".pm" from "...Acme/EyeDrops.pm" giving directory name.
my $eye_dir = __FILE__; chop($eye_dir);chop($eye_dir);chop($eye_dir);

sub slurp_yerself { _slurp_tfile($eye_dir . '.pm') }

sub get_eye_dir { $eye_dir }

1;

__END__

=head1 NAME

Acme::EyeDrops - Visual Programming in Perl

=head1 SYNOPSIS

    use Acme::EyeDrops qw(sightly);

    print sightly( { Shape       => 'camel',
                     SourceFile  => 'eyesore.pl' } );

=head1 DESCRIPTION

C<Acme::EyeDrops> converts a Perl program into an equivalent one,
but without all those unsightly letters and numbers.

In a Visual Programming breakthrough, EyeDrops allows you to pour
the generated program into various shapes, such as UML diagrams,
enabling you to instantly understand how the program works just
by glancing at its new and improved visual representation.

Unlike C<Acme::Bleach> and C<Acme::Buffy>, the generated program runs
without requiring that C<Acme::EyeDrops> be installed on the target
system.

=head1 EXAMPLES

=head2 Getting Started

Suppose you have a program, F<helloworld.pl>, consisting of:

    print "hello world\n";

To convert this little program into an equivalent camel-shaped one,
create F<cvt.pl> as follows:

    # cvt.pl. Convert helloworld.pl into a camel shape.
    use Acme::EyeDrops qw(sightly);
    print sightly( { Shape       => 'camel',
                     SourceFile  => 'helloworld.pl',
                     Regex       => 1 } );

Then run it like this:

    perl cvt.pl >new.pl

After inspecting the newly created program, F<new.pl>, to verify that
it does indeed resemble a camel, run it:

lib/Acme/EyeDrops.pm  view on Meta::CPAN

           =')'^'['; $/='`'|'.';$,='('
         ^'}';$\='`' |'!';$:=')'^'}';$~=
        '*'|"\`";$^= '+'^'_';$/='&'|"\@";
       $,='['&'~';$\ =','^'|';$:='.'^"\~";
      $~='@'|'(';       $^=')'^'[';$/="\`"|
     ('.');$,=            '('^'}';$\='`'|'!'
    ;$:="\)"^               '}';$~='*'|'`';$^
    ='+'^'_'                 ;$/='&'|'@';$,="\["&
   "\~";$\=                    ','^'|';$:='.'^"\~";$~=
   '@'|'(';                     $^=')'^'[';$/='`'|'.';$,=
  '('^'}';             $\='`'|'!';$:=')'^'}'  ;$~='*'|'`'
  ;($^)=               '+'^'_';$/='&'|'@'   ;$,='['&"\~";
  ($\)=                ','^'|';$:="\."^  '~';$~='@'|"\(";
 $^=')'                ^'[';$/='`'|'.'  ;$,='('^('}');$\=
 ('`')|                '!';$:=')'^'}'  ;$~="\*"|  "\`";$^=
 ('+')^       (        '_');$/=('&')|  "\@";        $,='['
 &"\~";   (       (    $\))      =','  ^+            "\|";
 $:='.'                ^((        '~')               );($~)
 ="\@"|     '(';$^     =(          ')')      ^'[';    $/='`'
 |"\.";    $,="\("^    ((          '}')   );$\='`'|('!');$:=
 (')')^                '}'        ;$~=  '*'|'`';$^='+'^'_';$/
 ="\&"|                '@';      ($,)  ='['&'~';$\=','^'|';$:
 ="\."^                '~';$~='@'|'(' ;$^=')'^       "\[";$/=
 ('`')|                '.';$,='('^'}' ;($\)         ='`'|'!';
 $:=')'                               ^((    '}'));$~='*'|'`'
  ;($^)                               =(   '+')^'_';$/=('&')|
  '@';$,            =      (              '[')&   '~';$\=','^
  '|';$:            = (  ( (              '.'      )))^'~';$~
   ="\@"|                              (( ((       '('))));$^
   =(')')^                             (( (       "\[")));$/=
   '`'|'.';          $,  =(          ( ((        '('))))^'}'
    ;$\='`'|       '!';$:=')'          ^+      '}';$~=('*')|
    "\`";$^= (       "\+")^         ( '_') ;$/='&'|('@');$,=
    '['&"\~";                         ($\) =','^'|';$:="\."^
    '~';$~='@'  |                 (   '('); $^=')'^('[');$/=
     '`'|'.';$,                 =     ('(')^ '}';$\='`'|'!';
     $:=')'^'}';    (  (  (  (        $~))))= '*'|'`';$^='+'^
      '_';$/='&'                      |'@';$, ='['&'~';$\=','
       ^"\|";$:=                       '.'^'~' ;$~='@'|'(';$^=
        ')'^'[';                        $/='`'| '.';$,='('^'}';
         $\='`'|                         '!';$:= ')'^'}';$~='*'|
          '`';$^                          ="\+"^  '_';$/='&'|'@';
           ($,)                            ='['    &'~';$\=','^'|'

=head2 Just another Perl hacker

Let's get more ambitious and create a big self-printing I<JAPH>.

    my $src = <<'FLAMING_OSTRICHES';
    open 0;
    $/ = undef;
    $x = <0>;
    close 0;
    $x =~ tr/!-~/#/;
    print $x;
    FLAMING_OSTRICHES
    print sightly( { Shape         => 'japh',
                     SourceString  => $src,
                     Regex         => 1 } );

This works. However, if we change:

    $x =~ tr/!-~/#/;

to:

    $x =~ s/\S/#/g;

the generated program malfunctions in strange ways because
it is running inside a regular expression and Perl's regex engine
is not reentrant. In this case, we must resort to:

    print sightly( { Shape        => 'japh',
                     SourceString => $src,
                     Regex        => 0 } );

which runs the generated sightly program via C<eval> instead.
If you want to use Regex => 1 (to eliminate I<all> alphanumerics),
ensure the program to be converted is careful with its use of
regular expressions and C<$_>.

To produce a I<JAPH> that resembles the original
I<Just another Perl hacker,> aka I<Randal L Schwartz>, try this:

    print sightly( { Shape        => 'merlyn',
                     SourceString => 'Just another Perl hacker,',
                     Regex        => 1,
                     Print        => 1 } );

producing:

                       ''=~('('.'?'.'{'.('['
                    ^'+').('['^')').('`'|')').(
                 '`'|'.').('['^'/').'"'.('`'^'*')
              .('['                          ^'.')
            .('['                              ^'(')
           .('['                                ^'/')
         .('{'^                                 '[').(
        "\`"|                                    '!').(
       '`'|                                      '.').(
      '`'|          (                (           '/'))).
    ('['            ^              ( (          '/'))).(
   '`'|           (              (  (         ( '('))))).
  ('`'|         (              (    (        (  '%'))))).
  ('['^       (              (    (        (    ')'))))).
  ('{'^      '[')        .(      (      ((      ('{'))))^
  '+').     (    '`'|'%'       ).("\["^         ')').('`'
 |',').('{'^                                    '[').('`'
 |'(').('`'                                      |"\!").(
 '`'|'#').(        ('`')|             '+').(     '`'|'%')
 .('['^')')     .((      ','       )).      '"'   .('}').
 "\)");$:=         ('.')^       (     "\~");      $~='@'|
 ('(');$^=       (( ')'  ))     ^   (( '['  ))     ;($/)=
  '`'|'.';       $,='('^'}'     ;   $\='`'|'!'      ;($:)
  =(')')^                       (                    '}'
   );($~)                       =                    '*'
    |'`';                     ( ( (                  $^)
    )  )=                    (  (  (                 '+'
    )   )                   ) ^ ( ( (               '_'
    )   )                   ) ; ( ( (               $/
    )   )                                          ) =

lib/Acme/EyeDrops.pm  view on Meta::CPAN

                     SourceString    => <<'END_SRC_STR' } );
    $-=!$%<<(pop||4);print$"x$-,map($-&$_?'  ':'/\\',$%..$.++),$/while$---
    END_SRC_STR

producing:

 ''=~('(?{'.('`'|'%').('['^'-').('`'|'!').('`'|"\,").'"\\$-=!\\$%<<('.(
 '['^'+').('`'|'/').('['^'+').'||'.('^'^('`'|'*')).');'.('['^'+').('['^
 ((                                                                  ((
 ((                                ((                                ((
 ((                               ')')                               ))
 ))                              ))  ))                              ))
 ))                             .(('`')|                             ((
 ((                            ((      ((                            ((
 ((                           ')')    ))))                           ))
 ))                          ))  ))  .(  ((                          ((
 ((                         '`'))))))|'.').(                         ((
 ((                        ((              ((                        ((
 ((                       '[')            ))))                       ))
 ))                      ))  )^          ((  ((                      ((
 ((                     '/')))))        )))).''.                     ((
 ((                    ((      ((      ((      ((                    ((
 ((                   '\\'    ))))    ))))    ))))                   ))
 ))                  .+  ((  ((  ((  ((  ((  ((  ((                  ((
 ((                 '$')))))))))))))))))).'\\"'.('['                 ^+
 ((                ((                              ((                ((
 ((               '#')                            ))))               ))
 ))              ))  .+                          ((  ((              ((
 ((             '\\'))))                        )))).'$'             .+
 ((            ((      ((                      ((      ((            ((
 ((           '-')    ))))                    ))))    ))))           ).
 ((          ((  ((  ((  ((                  ((  ((  ((  ((          ((
 ((         ',')))))))))))))                ))))))))).("\`"|         ((
 ((        ((              ((              ((              ((        ((
 ((       '-')            ))))            ))))            ))))       ))
 ))      .(  ((          ((  ((          ((  ((          ((  ((      ((
 ((     '`')))))        ))))))))        )))))|((        '!'))).(     ((
 ((    ((      ((      ((      ((      ((      ((      ((      ((    ((
 ((   '[')    ))))    ))))    ))))    ))))    ))))    )))^    '+')   .+
 ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((  ((
 (( '(')))))))))))))))))))))))))))))))))))))).'\\$-&\\$_?'."'".('{'^ ((
 ((                                                                  ((
 '['))))))).('{'^'[')."'".':'."'".'/\\\\\\\\'."'".',\\$%..\\$.++),\\$/'
 .('['^',').('`'|'(').('`'|')').('`'|',').('`'|'%').'\\$---"})');$:='.'

=head2 Dueling Dingos

During the TPR02 Perl Golf tournament, I<`/anick> composed a poem
describing his experience, entitled I<Dueling Dingos>.

You can produce a program that emits his moving poem like this:

    print sightly( { Shape        => 'yanick3',
                     Regex        => 1,
                     Print        => 1,
                     SourceString => <<'END_DINGO' } );
    #!/usr/bin/perl
    # Dueling Dingos v1.1, by Yanick Champoux (9/4/2002)
    #
    # Inspired by the TPR(0,2) Perl Golf contest.
    # Name haven't been changed, since the involved
    # parties could hardly be labelled as 'innocent',
    # and are way far too gone to protect anyway.
    wait until localtime > @April[0];  # wait until the first of April
    BEGIN{}
    study and seek FOR, $some, $inspiration;
    write $stuff;
    $score = 145; # no good;
    delete $stuff { I_can_do_without }
       and do $more_stuff;
    delete $even{more_stuff};
    reverse $engineer; study; eval $strategy and redo;
    write, write, write;
    delete $_{'!'}, delete $"{"@!"}, delete $@{'*'}; # must stop cursing
    use less 'characters', $durnit;
    read THE, $current, $solution;
    not 2, $bad;
    delete $white_spaces{''} until $program == glob;
    for( $all, my @troubles )
    {
        unlink 1, $character;
    }
    ARGH:
    $must, not $despair;
    $I->can(do{ $it });
    study new Idea;
    m/mmmm/m... do{able};
    kill $chickens;
    'ask', $Nanabozo, 2, bless $me, 'with more inspiration';
    $so, close; warn $mailing_list and alarm $Andrew;
    $toil until my $solution < /-\ndrew's
    /;
    GOT_IT:
    send $solution, $to, ref;
    $brain, shutdown  I,'m dead';
    goto sleep;
    wait; $till, $the, $day, $after;
    readline last $scoreboard;
    grep $all, stat;
    read THE, $stats, $again until $it_sinks_in;
    $Andrew,'s score' lt $mine;
    $eyeball, pop @o
    ;
    END_DINGO

The generated program, being 2577 lines long, is not reproduced here.
To generate a shorter program summarising I<`/anick>'s TPR02 anguish:

    print sightly( { Shape        => 'yanick,eye,mosquito,coffee',
                     Gap          => 3,
                     Regex        => 1,
                     Print        => 1,
                     SourceString => <<'END_SUFFERING' } );
    My head is hurting, my right eye feels like it's going to pop
    like a mosquito drinking from an expresso addict with high
    blood pressure, I want to crawl somewhere damp and dark and
    quiet and I consider never to touch a keyboard again.
    END_SUFFERING

producing:

lib/Acme/EyeDrops.pm  view on Meta::CPAN

Currently, the allowed shape properties are:

    name
    nick
    description
    cpanid
    author
    authorcpanid
    source
    keywords

where valid keywords are:

    face
    person
    perlhacker
    animal
    object
    planet
    map
    flag
    sport
    underwear
    hbanner
    vbanner
    logo
    debian
    opera

To give an example of how shape properties might be used,
to find all shapes that depict just the faces of perl hackers:

    use Acme::EyeDrops qw(find_eye_shapes);
    my @perlhackers = find_eye_shapes('face',
                                      'person',
                                      'perlhacker');

Note that there is an implicit AND between each keyword;
that is, the above code finds all shapes with face AND
person AND perlhacker keywords.

Additionally, you may use OR in any argument, for example:

    my @perlhackers = find_eye_shapes('face',
                                      'person OR animal',
                                      'perlhacker');

finds all shapes matching face AND (person OR animal)
AND perlhacker.

Instead of using the API, as shown above, you may also use
the F<findshapes.pl> command in the F<demo> directory:

    findshapes.pl -h           (for help)
    findshapes.pl -v face person perlhacker

The last example displays the faces and properties of all
perl hackers.

Please note that these shape properties are experimental and
may change in future A::E releases.

=head1 BUGS

A really diabolical shape with lots of single character lines
will defeat the shape-pouring algorithm.

You can eliminate all alphanumerics (via Regex => 1) only if the
program to be converted is careful with its use of regular
expressions and C<$_>.
To convert complex programs, you must use Regex => 0, which
emits a leading unsightly double C<eval>.

The code generated by non-zero Regex requires Perl 5.005 or higher
in order to run; when run on earlier versions, you will likely
see the error message: C<Sequence (?{...) not recognized>.

If using Perl 5.18+, the generated file needs a leading
"use re 'eval'" when a postive value for Regex is used.

The converted program runs inside an C<eval> which may cause
problems for non-trivial programs. A C<die> statement or
an C<INIT> block, for instance, may cause trouble.
If desperate, give the C<TrapEvalDie> and C<TrapWarn>
attributes a go, and see if they fix the problem.

If the program to be converted uses the Perl format variables
C<$:>, C<$~> or C<$^> you may need to explicitly set the
C<FillerVar> attribute to a Perl variable/s not used by the program.

Linux F</usr/games/banner> does not support the following characters:

    \ [ ] { } < > ^ _ | ~

When the CPAN Text::Banner module is enhanced, it will be used
in place of the Linux banner command.

=head1 AUTHOR

Andrew Savige <asavige@cpan.org>

=head1 SEE ALSO

Acme::EyeDrops lightning talk by Flavio Poletti at YAPC::Europe 2008 at F<http://yapc.tv/>.

Acme::EyeDrops in JPerl Advent Calendar (Japanese)
at F<http://perl-users.jp/articles/advent-calendar/2009/casual/08.html>.

The history of Acme::Bleach, Acme::EyeDrops and related modules
at F<http://www.perlmonks.org/?node_id=967004>.

Software Art page at F<http://www.runme.org/>.

Acme's Y::E 2002 naked arm wrestling movie at
F<http://astray.com/tmp/yapcbits3.mov>.

Japanese translations of selected CPAN modules (including Acme::EyeDrops)
can be found at F<http://perldoc.jp/docs/modules/>.
(Japanized Perl Resources Project is at
F<https://sourceforge.jp/projects/perldocjp/>).



( run in 0.798 second using v1.01-cache-2.11-cpan-5a3173703d6 )