##
# program to strip off comments from the input perl file
# file and write it to nc<filename>.<ext> 
# Remove perl comments thru a perl file!
##

$ifile=readInput("Enter the input file name");

$ofile="nc".$ifile;                # Choose a default name, '.' is concat op

if( -e $ofile)                     # if default name already exists     
 {
  do
  {
   $c=1;                           # take user input 
   $ofile=readInput("Enter a name for the output file");
       if( -e $ofile)
       {
         $ch=readInput("This file already exists, rewrite(y/n)?");
          if( ($ch eq "y") || ($ch eq "Y") )
           { $c=0; }
          else
           { $c=1; }
       }
       else { $c=0;}
   }while($c);
 }
 else
 {
  open(OFILE,$ofile);             # create o/p file
 }
 open(OFILE,$ofile); 		# create o/p file

if(open(IFILE,"<".$ifile))	# open the i/p file in Read mode
 {
 if( open(OFILE,">" . $ofile )) # open o/p file in write mode
  {
  $Fline=1;
   while(<IFILE>) 		# while i/p file exists
    {
       ##
       # if "#!<path>" matched in the first line by itself - retain it
       # as it means the absolute path to the Perl intepreter
       ##

       if($Fline && something($_) )   # a 'valid' first line
        {
         $Fline=0;
           # must be in the start of line only ( maybe preceded by \s+ )
           if( ($_ =~ m/^\#!/) || ($_ =~ m/\s+\#!/) )   
             {
               print OFILE $_;     
               next;                  # continue with the next iteration
             }
        }

       if( ($_ =~ m/\#/) )
        {
         $yes=1;                # comment present in the current line
        }                       # \s = [ \n\r\t\f]


      if(InsideString($_,\@p))  # special case "in a string", pass reference
      {
        # apply substitution for the last part only

        $p[3] = ApplySubst($p[3]);

        #  and concat back to $_

        $_ = $p[0]."\"".$p[1]."#".$p[2]."\"".$p[3]; 
      }
      else                      # normal substitution
       {
        $_ = ApplySubst($_);
       }
                                
      # removal of blank lines after substitution

      if($yes)
       {
        if(something($_))       # If some printable chars present after match
           {    print OFILE $_;     }
       }
      else {    print OFILE $_;     }
      
      $yes=0;

    } # end while

  close(OFILE);
  print "\nWritten to : $ofile\n";
  }
  else
   {
    print "cannot open o/p file";
   }
  close(IFILE);

 }  # end if {i/p file}
 else
 {
 print "cannot open i/p file";
 }

exit(0);                     # end of program

## start of subroutines ##

# return 1 if some printable chars present 0 if not

sub something
{
 my ($line)=@_;              # scalar assignment
 my $len=length($line);
 my $count=0,$i,$test;
 for($i=0;$i<$len;$i++)
  {
   $test=substr($line,$i,1); # 1 char at $i from $line
   if($test =~ m/\s/)
    {
     $count++;               # count of all non printable characters    
    }
  }
 if($len==$count)  {  return 0; }
  else             {  return 1; }
 }

 # return 1 if the '#' character found embedded in a double quoted string

 sub InsideString
     {
        ($a,$pRef) = @_;                 # sent array reference
      
        if($a =~ m/(.*)"(.*)#(.*)"(.*)/) # positionalize into 4 parts
         {
          @{$pRef}[0]=$1;                # storing in array using reference
          @{$pRef}[1]=$2;
          @{$pRef}[2]=$3;
          @{$pRef}[3]=$4."\n";

          # as match(.*) will no match "\n" at the end, concat "\n" 

          return 1;             
         }
         return 0;
     }

 # apply the substitution for the sent variable to remove the comment

 sub ApplySubst
     {

      my($l)=@_;                        # receive from parameter array

       ##
       # anything after # removed until \s(as last char)
       # the # must not be preceded by a $, as $# is a special variable
       # or not preceded by \ because an escaped # means it is not used
       # as a comment but in pattern match
       ##
     
       if($l !~ m/(\$|\\)\#/)           # not preceded by $ or \
        {
         $l =~ s/\#(.*)\s/\n/g ;        # regExp: #(characters)ending with \s
        }
       elsif($l =~ m/(.*)(\$|\\)\#(.*)/)# position into 3 parts
        {                               # and check the last part
             $L = $1;                   # as positional vars are read only  
             $M = $2;
             $R = $3."\n";              # as (.*) does not fetch "\n" concat
             if($R !~ m/(\$|\\)\#/)     # if $R has no 'special' #
             {
               $R =~ s/\#(.*)\s/\n/g ;  # apply regExp again for right part
             }
          $l = $L.$M."#".$R;            # concat back into $l
        }

       return $l;                       # return the substituted string
      }

# Start readinp(To read keyboard input)
sub readInput
{
 my($p)=shift @_;               # get the parameter passed(prompt)
 my $line,$c;
 do
 {
  $c=1;
  print "\n$p\t:";
  chop ($line=<STDIN>);
     if(!$line || !something($line))
      {
       print "You did not enter anything, again \n";
       $c=1;
      }else { $c=0;}
   }while($c);
  return $line;                 # return the input
} # end readinp