fork download
copy 
  1. #!/usr/bin/perl
  2. package Dogless;
  3. use strict;
  4. use warnings; no warnings 'uninitialized';
  5. use v5.10;
  6. use Getopt::Long;
  7.  
  8. sub help {
  9. <<__HELP__
  10. Usage: $0 [options] [files]
  11.  
  12. Interprets dogless programs passed as command line arguments, or from stdin if no files are specified.
  13.  
  14. Options:
  15.  
  16.   -d --debug        Enters debug mode, the source code is 
  17.                     printed for each transformation.
  18.   -h --help         This help text
  19.  
  20.   -i --interval     specifies a decimal interval in seconds to
  21.                     wait between commands
  22. __HELP__
  23. }
  24.  
  25. #command line options
  26. my ($help, $debug_mode, $interval);
  27.  
  28. my $any_command;
  29. $any_command = qr/(?:<|>)(??{$any_command})|\$..|\\?.|$/s;
  30.  
  31. sub run_cmd {
  32.     my ($_, $pre, $post, $s) = @_;
  33.     my ($x, $y, $c);
  34.     if(($c) = /^<(.*)$/p) {
  35.         $pre =~ /\||$/p;
  36.         $pre = run_cmd($c, ${^PREMATCH}, ${^POSTMATCH}, ${^MATCH});
  37.         return "$pre$s$post";
  38.     }
  39.     elsif (($c) = /^>(.*)$/p) {
  40.         $post =~ /\||$/p;
  41.         $post = run_cmd($c, ${^PREMATCH}, ${^POSTMATCH}, ${^MATCH});
  42.         return "$pre$s$post";
  43.     }
  44.     elsif(($x, $y) = /^\$(.)(.)$/s) {
  45.         $_ = "$pre$s$post";
  46.         s/\Q$x\E/$y/;
  47.         return $_;
  48.     }
  49.     elsif (/^"$/) {
  50.         $post =~ /^[^"]*("|$)/p;
  51.         return "$pre$s${^POSTMATCH}";
  52.     }
  53.     elsif (/^\?$/) {
  54.         return reverse "$pre$s$post";
  55.     }
  56.     elsif (/^\^$/) {
  57.         return "$post$s$pre";
  58.     }
  59.     elsif (/^~$/) {
  60.         return "$pre$s$post$pre$s~$post";
  61.     }
  62.     elsif (/^!$/) {
  63.         return '';
  64.     }
  65.     elsif (/^\|$/) {
  66.         return "$pre$s$post";
  67.     }
  68.     elsif (($c) = /^\\?(.)$/sp){
  69.         return "$pre$c$s$post";
  70.     }
  71.     else {
  72.         return "$pre$post";
  73.     }
  74. }
  75.  
  76. sub interpret {
  77.     my ($_) = @_;
  78.     while (/\|($any_command)/p) {
  79.         say if $debug_mode;
  80.         sleep $interval if defined $interval;
  81.         $_ = run_cmd($1, ${^PREMATCH}, ${^POSTMATCH}, '|');
  82.     }
  83.     return $_;
  84. }
  85.  
  86.  
  87. unless (caller) {
  88.     GetOptions ("help|h" => \$help,
  89.                 "debug|d" => \$debug_mode,
  90.                 "interval|i=f" => \$interval,
  91.                ) or die "Invalid options.";
  92.     say help() and exit if $help;
  93.     print interpret (join '', <>);
  94. }
Success #stdin #stdout #stderr 0.02s 7072KB
comments (?)
stdin
copy 
abcdef|ghijkl|mn"op"|<$gA$me>|<$kl$dl>|<$nH$jo>|<$er>|<$cd$AW>|<$hx$fo>|$a!$i,$x $b\?
stdout
copy 
Hello, World!
stderr
copy 
Use of my $_ is experimental at prog.pl line 32.
Use of my $_ is experimental at prog.pl line 77.
https://ideone.com/NQp4sp
language:
Perl (perl 5.28.1)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!