jpp

#!/usr/bin/perl

# NOTE: this program only accepts 'single' line require statements

use strict;
use warnings;
use Getopt::Long; # to get command line options
use Cwd 'realpath'; # realpath: symbolic links and relative-path components ("." and "..") are resolved to return the canonical path a given file
use File::Spec; # file name functions

our $RX_REQUIRE = '^'.'[\s]*'.'(?:from[\s]+(\w+)[\s+])?'.'[\s]*'.'require'.'[\s]*'.'"'.'([\w./_-]+)'.'"';
our $LINE_COMMENT = "//";

sub jpp_main()
{
  my ($in,$out) = (undef,undef); # input (-in) and output (-out) filenames
  my @include_a = (); # list of includes (-I) in the form "-I" (ident):(relative or absolute path); check jasminc -help
  my $verbose = 0; # verbose (-v) mode, to print debug information, preceded by $LINE_COMMENT
  my %visited_h = (); # set of visited files (to ensure that a file is not included twice) in the form 'real path' -> 'number of times it has been required'
  my $reconstruct = 0; # flag to indicate if the preprocessed file should contain information for later reconstruction (reverse the preprocessing)

  GetOptions( # get the command line arguments
    'in=s' => \$in, 
    'out=s' => \$out,
    'include|I=s' => \@include_a,
    'verbose|v' => \$verbose,
    'reconstruct|r' => \$reconstruct
  );

  my ($preprocessed_ar, $visited_hr, $include_hr) = jpp($in, $out, \@include_a, $verbose, $reconstruct);
}


sub jpp()
{
  # arguments
  my $in = shift; # input file (-in)
  my $out = shift; # output file (-out)
  my $include_ar = shift; # list of includes (-I)
  my $verbose = shift; # verbose (-v)
  my $reconstruct = shift; # reconstruct (-r)

  # local var
  my %visited_h = (); # set of visited files (to ensure that a file is not included twice) in the form 'real path' -> 'number of times it has been required'

  # -in is mandatory
  if(! defined $in) { dump_usage(); exit; }

  $in = realpath($in); # get the absolute path;
  $out = realpath($out) if(defined $out); # same, if there is out
  my $include_hr = parse_includes($include_ar); # hash (reference) in the form 'ident'->'real path'
  dump_options($in, $out, $include_hr) if($verbose); # dump command line options if verbose

  # 'preprocess' is a recursive function that
  #  - starts by visiting $in and it recursivly imports the contents of required files
  #  - it appends (and returns) the contents of visited files into $preprocessed_ar (an array reference) that contains the code (one line per array element)
  #  - it receives as arguments: 
  #  -- $in (first file); $include_hr (hash ref. to "-I"'s); \%visited_h (hash ref to visited files, initially empty);
  #  -- verbose (to print some debug info); level (to keep track of current search depth and do indentation, initially 0);
  my ($preprocessed_ar, $visited_hr) = preprocess($in, "entry", $include_hr, \%visited_h, $reconstruct, $verbose, 0);

  # dump the preprocessed contents to $out file
  store($out, $preprocessed_ar) if(defined $out);
  dump_visited($visited_hr) if($verbose);

  return $preprocessed_ar, $visited_hr, $include_hr;
}


# transforms -I command line arguments into the set that was previously described; returns a reference to the said set;
sub parse_includes
{
  my $include_ar = shift;
  my %include_h = ();
  for my $i (@$include_ar)
  { my ($key,$value) = split(':', $i);
    $include_h{$key} = realpath($value);
  }
  return \%include_h;
}

# loads the lines of a given file to an array; returns a reference to the array;
sub load
{ my $fn = shift;
  my @lines = ();
  open my $fh, "<", $fn or die "Error: load $fn: $!";
  { @lines = <$fh>; chomp @lines; }
  close $fh;
  return \@lines;
}

# prints the contents of the file into a file
sub store
{ my $fn = shift;
  my $lines_ar = shift;
  if(defined $fn)
  { open my $fh, ">", $fn or die "Error: store $fn: $!";
    { print $fh join("\n", @$lines_ar), "\n"; }
    close $fh;
  }
  else
  { print STDOUT join("\n", @$lines_ar), "\n";  }
}

# check annotation in main subroutine
sub preprocess
{
  my $in = shift; # expects an absolute path
  my $parent = shift;
  my $include_hr = shift; # set of include paths
  my $visited_hr = shift; # hash to check if a file was already required, initially empty
  my $reconstruct = shift; 
  my $verbose = shift;
  my $level = shift;

  if (defined $visited_hr->{$in}) # if file was already visited, increment counter and return;
  { 
    push @{$visited_hr->{$in}}, $parent;
    #$visited_hr->{$in} += 1;
    dump_multiple_visit($level,$in) if ($verbose);
    my @preprocessed_empty = ();
    return (\@preprocessed_empty, $visited_hr); # return an empty array if file was already visited
  }
  
  my $lines_ar = load($in); # load $in
  my @included_by = ($parent);
  $visited_hr->{$in} = \@included_by; # set visited file
  #$visited_hr->{$in} = 1;

  my($vol,$dir,$filename) = File::Spec->splitpath($in); # split $in filename, can be reconstructed with catpath()
  my $base = File::Spec->catpath(($vol,$dir));

  my @preprocessed = ();

  for my $line (@$lines_ar) # for all lines...
  { if($line =~ m/$RX_REQUIRE/) # check if it matches with *require*
    {
      # push the current require line to allow for later reconstruction (new feature, not yet implemented)
      push (@preprocessed, ($LINE_COMMENT . "BOR" . $LINE_COMMENT . $line)) if ($reconstruct);

      # if $1 is set ( "(?:from[\s]+(\w+)[\s+])?" ), then there is a "from 'ident'" in the require statement"
      # and $2 contains a relative path or absolute path...
      my $file = (defined $1) ? File::Spec->catfile(($include_hr->{$1}), $2) : # "from 'ident' require 'path'" implies relative path
                 ((File::Spec->file_name_is_absolute($2))? $2 : File::Spec->catfile(($base),$2)); # if absolute then let it be,
                                                                                                  # othersiwe concat with base from in
      $file = realpath($file); # realpath 'it'
      dump_match($level, $file) if($verbose); # if verbose dump some info
      my ($sublines_ar, $visited_hr) = preprocess($file, $in, $include_hr, $visited_hr, $reconstruct, $verbose, $level+1); # recursively fetch contents of other files
      push @preprocessed, @$sublines_ar; # add to the array the lines from the requires

      # push separator to indicate end of included file
      push (@preprocessed, ($LINE_COMMENT . "EOR" . "\n")) if ($reconstruct);
    }
    else
    { push @preprocessed, $line; } # in this case, since the line does not match a require statement, it is added to the array
  }

  return \@preprocessed, $visited_hr;
}

###############################################################################

sub dump_usage
{
  print STDOUT "error: -in INPUT_FILENAME is mandatory\n";
  print STDOUT "usage: jpp -in INPUT_FILENAME [options -I -v -r -out]\n";
}

sub dump_options
{
  my $in = shift;
  my $out = shift;
  my $include_hr = shift;

  print STDOUT $LINE_COMMENT . "v: options:\n";
  print STDOUT $LINE_COMMENT . "v:   in: $in\n";
  print STDOUT $LINE_COMMENT . "v:   out: $out\n" if(defined $out);
  print STDOUT $LINE_COMMENT . "v:   include: ";
  print STDOUT join("\n${LINE_COMMENT}v:            ",
    (map {$_ . "->". $include_hr->{$_}} (sort keys %${include_hr}))), "\n";
  print STDOUT "\n";
}

sub dump_match
{
  my $level = shift;
  my $file = shift;
  my $spacing = get_spacing($level);
  print STDOUT $LINE_COMMENT . "v: ${spacing}require $file\n";
}

sub dump_multiple_visit
{
  my $level = shift;
  my $file = shift;
  my $spacing = get_spacing($level);
  print STDOUT $LINE_COMMENT . "v: ${spacing}multiple require $file\n";
}

sub dump_visited
{
  my $visited_hr = shift;

  print STDOUT "\n" . $LINE_COMMENT . "v: visited\n";
  for my $f (sort keys %$visited_hr)
  { my @parents = @{$visited_hr->{$f}};
    print STDOUT $LINE_COMMENT. "v: $f ->\n${LINE_COMMENT}   ";
    print STDOUT join("\n${LINE_COMMENT}   ", @parents), "\n";
  }
}

sub get_spacing
{
  my $level = shift;
  my $spacing = join '', ("  " x $level);
  return $spacing;
}

###############################################################################

unless (caller) { jpp_main(); }

1;