fork download
copy 
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4.  
  5. my $file = "STDIN"; #$ARGV[0];
  6.  
  7. my $debug = 0;
  8.  
  9. my ($rest, $code, $ignore) = ("");
  10. my $lineNumber = 1;
  11. my $topLineOfBlock;
  12.  
  13. #open(my $inputFH, "<:raw:crlf", $file) or die "can't open $file for reading. $!";
  14. #open(my $outputFH, ">:raw:crlf", "$file.out") or die "can't open $file.out for writing. $!";
  15. my $inputFH = \*STDIN;
  16.  
  17. my $complete = 1; # NOTE: These 2 must be declared in the base scope of the package.
  18. my $lineOffset;   #       See https://r...content-available-to-author-only...l.org/Ticket/Display.html?id=120554 for details.
  19.  
  20. while ($_ = <$inputFH>, !eof($inputFH) or length($rest) != 0)
  21. {
  22.   $topLineOfBlock = $lineNumber;
  23.   print "Read line $lineNumber\n" if $debug;
  24.   if (defined $_)
  25.   {
  26.     $_ = "$rest$_";
  27.   }
  28.   else
  29.   {
  30.     $_ = $rest;
  31.   }
  32.   my $loopAgain;
  33.   do
  34.   {
  35.     if (/\\$/)  # if line ends with '\' read and append in next line
  36.     {
  37.       $complete = 0;
  38.     }
  39.     elsif (eof($inputFH) or /;\s*+$/) # if eof or line does end in a ';', break it up.
  40.     # otherwise read and append in next line.
  41.     {
  42.       print "INPUT: '$_'\n" if $debug;
  43.       use re 'eval';
  44.       m%
  45.           (?{print "STRING: '${^POSTMATCH}'\n" if $debug})
  46.           (?{$lineOffset = 0})
  47.           # ROUTINES
  48.             (?!) # Ignore this section for matching
  49.  
  50.           # DEBUG ROUTINES
  51.           # Call them using (?N) where N is the corrisponding number.
  52.             ((?{print  "1]'${^MATCH}'\n" if $debug}))
  53.             ((?{print  "2]'${^MATCH}'\n" if $debug}))
  54.             ((?{print  "3]'${^MATCH}'\n" if $debug}))
  55.             ((?{print  "4]'${^MATCH}'\n" if $debug}))
  56.             ((?{print  "5]'${^MATCH}'\n" if $debug}))
  57.             ((?{print  "6]'${^MATCH}'\n" if $debug}))
  58.             ((?{print  "7]'${^MATCH}'\n" if $debug}))
  59.             ((?{print  "8]'${^MATCH}'\n" if $debug}))
  60.             ((?{print  "9]'${^MATCH}'\n" if $debug}))
  61.             ((?{print "10]'${^MATCH}'\n" if $debug}))
  62.             ((?{print "11]'${^MATCH}'\n" if $debug}))
  63.             ((?{print "12]'${^MATCH}'\n" if $debug}))
  64.             ((?{print "13]'${^MATCH}'\n" if $debug}))
  65.             ((?{print "14]'${^MATCH}'\n" if $debug}))
  66.             ((?{print "15]'${^MATCH}'\n" if $debug}))
  67.             ((?{print "16]'${^MATCH}'\n" if $debug}))
  68.             ((?{print "17]'${^MATCH}'\n" if $debug}))
  69.             ((?{print "18]'${^MATCH}'\n" if $debug}))
  70.             ((?{print "19]'${^MATCH}'\n" if $debug}))
  71.  
  72.           # SUBROUTINES
  73.             # States that code read in is in an incomplete state.
  74.             (?<INCOMPLETE>(?{print "INCOMPLETE: '${^MATCH}'\n" if $debug; $complete = 0;}))
  75.  
  76.             # States that code read in is in a completed state.
  77.             (?<COMPLETE>  (?{print "COMPLETE: '${^MATCH}'\n"   if $debug; $complete = 1;}))
  78.  
  79.             # Matches against one character that has been escaped including EOL.
  80.             # If a quoted EOL found, mark match as incomplete.
  81.             (?<ESCAPED_CHAR>
  82.               \\
  83.               (?:
  84.                 (?&EOL)       (?&INCOMPLETE)
  85.                 | (?s).
  86.               )
  87.             )
  88.  
  89.             # Matches against a single quoted string excluding EOL.
  90.  
  91.             (?<SINGLE_QUOTED_STRING>
  92.               '(?&INCOMPLETE)        # Adding ' to limit to syn hilight bug in ideone.com
  93.               (?:
  94.                   [^'\\\\n]++        # Adding ' to limit to syn hilight bug in ideone.com
  95.                 | (?&ESCAPED_CHAR)
  96.               )*+
  97.               '(?&COMPLETE)          # Adding ' to limit to syn hilight bug in ideone.com
  98.             )
  99.  
  100.             # Matches against a double quoted string excluding EOL.
  101.             (?<DOUBLE_QUOTED_STRING>
  102.               "(?&INCOMPLETE)        # Adding " to limit to syn hilight bug in ideone.com
  103.               (?:
  104.                   [^"\\\n]++         # Adding " to limit to syn hilight bug in ideone.com
  105.                 | (?&ESCAPED_CHAR)
  106.               )*+
  107.               "(?&COMPLETE)          # Adding " to limit to syn hilight bug in ideone.com
  108.             )
  109.  
  110.             # matches strings intermingled with other chars excluding EOL.
  111.             (?<STRINGS_WITH_CHARS>
  112.               (?:
  113.                   [^\\\n"']++        # Adding " to limit to syn hilight bug in ideone.com
  114.                 | (?&DOUBLE_QUOTED_STRING)
  115.                 | (?&SINGLE_QUOTED_STRING)
  116.                 | (?&ESCAPED_CHAR)
  117.               )*+
  118.             )
  119.  
  120.             # Matches against non escaped characters excluding EOL.
  121.             (?<NON_ESCAPED_CHARS> [^\\\n]++)
  122.  
  123.             # Matches all non escaped chars and escaped chars.
  124.             # upto but not including the EOL unless it's escaped.
  125.             (?<CHARS> (?:(?&NON_ESCAPED_CHARS)|(?&ESCAPED_CHAR))*+)
  126.  
  127.             # Matches EOL (end of line) or EOS (end of string) and states it is in a complete state.
  128.             (?<EOL_OR_EOS> (?&EOL) | $     (?&COMPLETE))
  129.  
  130.             # Matches on EOL and increments $lineOffset if matched.
  131.             # When using this, make sure you don't allow backtracking over this call.
  132.             (?<EOL> \n(?{++$lineOffset}))
  133.  
  134.           | # ACTUAL SEARCH
  135.           (?<ignore>
  136.             (?:
  137.                 (?&EOL)? ^ [^\S\n]*+ \# (?&STRINGS_WITH_CHARS) (?&EOL_OR_EOS) # preprocessor statement
  138.               | \s*+ // (?&CHARS) (?&EOL_OR_EOS)    # line comment
  139.               | \s*+ /\* (?&INCOMPLETE)      # block comment
  140.                 (?:
  141.                     [^*]++
  142.                   | \* (?!/)
  143.                 )*+
  144.                 \*/ (?&COMPLETE)             # block comment completed
  145.             )*+
  146.           )
  147.           (?(?{$complete}) # completed parse of all ignored stuff?  Then read code stuff.
  148.             (?<code>
  149.               (?:
  150.                 (?!^[^\S\n]*+\#)               # do not match on a preprocessor statement
  151.                 (?:
  152.                     (?&DOUBLE_QUOTED_STRING)   # found a string
  153.                   | (?&SINGLE_QUOTED_STRING)   # found a string
  154.                   | (?: [^'"/\n]++ | /[^*/\n]) # found something not a string or comment or newline
  155.                     # Adding ' to limit to syn hilight bug in ideone.com
  156.                   | (?&EOL)                    # newline
  157.                 )
  158.               )*+
  159.             )
  160.             (?<rest>
  161.               (?s).*                         # match to the end of the string
  162.             )
  163.           ) # if not completed, read in more stuff and do parse over again.
  164.       %xmp;
  165.       ($code, $ignore, $rest) = ($+{'code'}, $+{'ignore'}, $+{'rest'});
  166.       print "**COMPLETE = $complete\n" if $debug;
  167.       goto BLOCK_READ_COMPLETE if $complete or eof($inputFH);
  168.     }
  169.     # read in more data to allow for a complete parse
  170.     ++$lineNumber;
  171.     print "Reading line $lineNumber\n" if $debug;
  172.  
  173.     my $newStuff = <$inputFH>;
  174.     if (defined $newStuff)
  175.     {
  176.       $_ .= $newStuff;
  177.       $loopAgain = 1;
  178.     }
  179.     else
  180.     {
  181.       $loopAgain = 0;
  182.     }
  183.   } while ($loopAgain);
  184.   BLOCK_READ_COMPLETE:
  185.   $complete or die "Something wasn't terminated at line ". ($topLineOfBlock+$lineOffset) ." of file '$file'.\n";
  186.  
  187.   # do transformation on $code
  188.  
  189.   print "CODE: >>$code<<\nIGNORE: >>$ignore<<\nREST: >>$rest<<\n" if $debug;
  190. #  print $outputFH "$ignore$code";
  191.   print "$ignore$code" if !$debug;
  192. }
  193.  
Success #stdin #stdout 0s 4160KB
comments (?)
stdin
copy 
# hello \
there
# how "\
this"
is /* not
;
code/**/
code "fs\
df"
# are
#you
stdout
copy 
# hello \
there
# how "\
this"
is /* not
;
code/**/
code "fs\
df"
# are
#you
https://ideone.com/mDN2kj
SO: how to separate stuff I want from what I don't in perl?<br><br>http://stackoverflow.com/questions/20009225/how-to-separate-stuff-i-want-from-what-i-dont-in-perl
language:
Perl (perl 5.28.1)
created:
10 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!