Rinchi-Fortran-Preprocessor

 view release on metacpan or  search on metacpan

lib/Rinchi/Fortran/Preprocessor.pm  view on Meta::CPAN

Rinchi::Fortran::Preprocessor - An Fortran to XML preprocessor extension for 
preprocessing Fortran files producing XML SAX parser events for the tokens 
scanned.

=head1 SYNOPSIS

 use Rinchi::Fortran::Preprocessor;

 my @args = (
   'test.pl',
   '-I/usr/include',
   '-Uccc',
 );

 my $closed = 0;

 my $fpp = new Rinchi::Fortran::Preprocessor;
 $fpp->setHandlers('Start'      => \&startElementHandler,
                   'End'        => \&endElementHandler,
                   'Char'       => \&characterDataHandler,
                   'Proc'       => \&processingInstructionHandler,
                   'Comment'    => \&commentHandler,
                   'CdataStart' => \&startCdataHandler,
                   'CdataEnd'   => \&endCdataHandler,
                   'XMLDecl'    => \&xmlDeclHandler,
                   );

 $fpp->process_file('test_src/include_test_1.h',\@args);

 sub startElementHandler() {
   my ($tag, $hasChild, %attrs) = @_;
   print "<$tag";
   foreach my $attr (sort keys %attrs) {
     my $val = $attrs{$attr};
     $val =~ s/&/&amp;/g;
     $val =~ s/</&lt;/g;
     $val =~ s/>/&gt;/g;
     $val =~ s/\"/&quot;/g;
     $val =~ s/\'/&apos;/g;
     print " $attr=\"$val\"";
   }
   if ($hasChild == 0) {
     print " />";
     $closed = 1;
   } else {
     print ">";
     $closed = 0;
   }
 }

 sub endElementHandler() {
   my ($tag) = @_;
   if ($closed == 0) {
     print "</$tag>\n";
   } else {
     $closed = 0;
   }
 }

 sub characterDataHandler() {
   my ($cdata) = @_;
   print $cdata;
 }

 sub processingInstructionHandler() {
   my ($target,$data) = @_;
   print "<?$target $data?>\n";
 }

 sub commentHandler() {
   my ($string) = @_;
   print "<!-- $string -->\n";
 }

 sub startCdataHandler() {
   print "<![CDATA[";
 }

 sub endCdataHandler() {
    print "]]>";
 }

 sub xmlDeclHandler() {
   my ($version, $encoding, $standalone) = @_;
   print "<?xml version=\"$version\" encoding=\"$encoding\" standalone=\"$standalone\"?>\n";
 }

=head1 DESCRIPTION

This module provides an interface to a Fortran preprocessor.

=head2 EXPORT

None by default.

=head1 METHODS

=over 4

=item new

Constructor for Fortran::Preprocessor. Options are TBD.

=cut

sub new {
  my ($class, %args) = @_;
  my $self = bless \%args, $class;
  $args{'_State_'} = 0;
  $args{'Context'} = [];
  $args{'ErrorMessage'} ||= '';
  $args{'_Setters'} = \%Handler_Setters;
#  $args{Parser} = ParserCreate($self, $args{ProtocolEncoding},
#                               $args{Namespaces});
  $self;
}

=item setHandlers(TYPE, HANDLER [, TYPE, HANDLER [...]])

This method registers handlers for the various events.

Setting a handler to something that evaluates to false unsets that
handler.

This method returns a list of type, handler pairs corresponding to the
input. The handlers returned are the ones that were in effect before the
call to setHandlers.

The recognized events and the parameters passed to the corresponding
handlers are:

=over 4

=item * Start             (tagname, hasChild [, attrName, attrValue [,...]])

  my ($tag, $hasChild, %attrs) = @_;
  print "<$tag";
  foreach my $attr (sort keys %attrs) {
    my $val = $attrs{$attr};
    $val =~ s/&/&amp;/g;
    $val =~ s/</&lt;/g;
    $val =~ s/>/&gt;/g;
    $val =~ s/\"/&quot;/g;
    $val =~ s/\'/&apos;/g;
    print " $attr=\"$val\"";
  }
  print ">\n";

This event is generated when an XML start tag is recognized. Parameter tagname 
is the name of the XML element that is opened with the start tag. Parameter 
hasChild indicates the presence of contained nodes. The attrName 
and attrValue pairs are generated for each attribute in the start tag.

=item * End               (tagname)

  my ($tag) = @_;
  print "</$tag>\n";

This event is generated when an XML end tag is recognized. Note that
an XML empty tag (<tagname/>) generates both a start and an end event.

=item * Char              (String)

  my ($cdata) = @_;
  print $cdata;

This event is generated when non-markup is recognized. The non-markup
sequence of characters is in String. A single non-markup sequence of
characters may generate multiple calls to this handler. Whatever the
encoding of the string in the original document, this is given to the
handler in UTF-8.

=item * Proc              (target, data)

  my ($target,$data) = @_;
  print "<?$target $data?>\n";

This event is generated when a processing instruction is created. Processing 
instructions are used to convey locations and error messages.

=item * Comment           (String)

  my ($string) = @_;
  print "<!-- $string -->\n";

This event is generated when a comment is recognized.

=item * CdataStart        ()

  print "<![CDATA[";

This is called at the start of a CDATA section.

=item * CdataEnd          ()

   print "]]>";

This is called at the end of a CDATA section.

=item * XMLDecl           (Version, Encoding, Standalone)

This handler is called for XML declarations. Version is a string containing
the version. Encoding is either undefined or contains an encoding string.
Standalone is either undefined, or true or false. Undefined indicates
that no standalone parameter was given in the XML declaration. True or
false indicates "yes" or "no" respectively.

=back

=cut

sub setHandlers {
  my ($self, @handler_pairs) = @_;

  croak("Uneven number of arguments to setHandlers method")
    if (int(@handler_pairs) & 1);

  my @ret;

  while (@handler_pairs) {
    my $type = shift @handler_pairs;
    my $handler = shift @handler_pairs;
   croak "Handler for $type not a Code ref"
     unless (! defined($handler) or ! $handler or ref($handler) eq 'CODE');

lib/Rinchi/Fortran/Preprocessor.pm  view on Meta::CPAN

  return undef;

}

=item startElementHandler()

Default start Element handler.

=cut

sub startElementHandler() {
  my ($tag, $hasChild, %attrs) = @_;

  print "<$tag";
  foreach my $attr (sort keys %attrs) {
    my $val = $attrs{$attr};
    $val =~ s/&/&amp;/g;
    $val =~ s/</&lt;/g;
    $val =~ s/>/&gt;/g;
    $val =~ s/\"/&quot;/g;
    $val =~ s/\'/&apos;/g;
    print " $attr=\"$val\"";
  }
  if ($hasChild == 0) {
    print " />";
    $closed = 1;
#    if($new_line{$tag} & 1) {
#      print "\n";
#    }
  } else {
    print ">";
    $closed = 0;
#    if($new_line{$tag} & 2) {
#      print "\n";
#    }
  }
}

=item endElementHandler()

Default end Element handler.

=cut

sub endElementHandler() {
  my ($tag) = @_;
  if ($closed == 0) {
    print "</$tag>";
  } else {
    $closed = 0;
  }
}

=item characterDataHandler()

Default Character Data handler.

=cut

sub characterDataHandler() {
  my ($cdata) = @_;
  print $cdata;
}

=item processingInstructionHandler()

Default Processing Instruction handler.

=cut

sub processingInstructionHandler() {
  my ($target,$data) = @_;
  print "\n<?$target $data?>\n";
}

=item commentHandler()

Default Comment handler.

=cut

sub commentHandler() {
  my ($string) = @_;
  print "<!-- $string -->\n";
}

=item startCdataHandler()

Default start CDATA handler.

=cut

sub startCdataHandler() {
  print "<![CDATA[";
}

=item endCdataHandler()

Default end CDATA handler.

=cut

sub endCdataHandler() {
   print "]]>";
}

=item xmlDeclHandler()

Default XML Declaration handler.

=cut

sub xmlDeclHandler() {
  my ($version, $encoding, $standalone) = @_;
  print "<?xml version=\"$version\" encoding=\"$encoding\" standalone=\"$standalone\"?>\n";
}

=item sub xml_outpute($path, [\@args])

 $fpp->xml_output('some_file.fpp' ,\@args);

Where $path is the path to the file to be parsed and $args is an optional 

lib/Rinchi/Fortran/Preprocessor.pm  view on Meta::CPAN

                  'XMLDecl'    => \&xmlDeclHandler,
                  );

  if (defined($args) and ref($args) eq 'ARRAY') {
    $fpp->process_file($path,$args);
  } else {
    $fpp->process_file($path);
  }

}

# source_out handlers

sub _startElementHandler() {
  my ($tag, $hasChild, %attrs) = @_;

  my $keyword = Rinchi::Fortran::Preprocessor->keyword_for_tag($tag);
  if (defined($keyword)) {
    print "$keyword";
    return;
  } elsif ($tag eq 'identifier') {
    print $attrs{'identifier'};
    return;
  } elsif ($tag eq 'white_space') {
    print $attrs{'value'};
    return;
  } elsif ($tag eq 'float_lit') {
    print $attrs{'value'};
    return;
  } elsif ($tag eq 'char_lit') {
    print "'$attrs{'value'}'";
    return;
  } elsif ($tag eq 'comment') {
    print '! ';
    return;
  } else {
    my $delim = Rinchi::Fortran::Preprocessor->delimiter_for_open_tag($tag);
    if (defined($delim)) {
      print "$delim";
      return;
    } else {
      my $op_punc = Rinchi::Fortran::Preprocessor->op_or_punc_for_tag($tag);
      if (defined($op_punc)) {
        print "$op_punc";
        return;
      }
    }
  }
}

sub _endElementHandler() {
  my ($tag) = @_;

  my $delim = Rinchi::Fortran::Preprocessor->delimiter_for_close_tag($tag);
  if (defined($delim)) {
    print "$delim";
  }
}

sub _characterDataHandler() {
  my ($cdata) = @_;
  print $cdata;
}

sub _processingInstructionHandler() {
  my ($target,$data) = @_;
  print "\n";
}

sub _commentHandler() {
  my ($string) = @_;
}

sub _startCdataHandler() {
}

sub _endCdataHandler() {
}

sub _xmlDeclHandler() {
  my ($version, $encoding, $standalone) = @_;
}

=item sub new_source($path, [\@args])

 $fpp->new_source('some_file.fpp' ,\@args);

Where $path is the path to the file to be parsed and $args is an optional 
reference to an array of arguments.

Parse the given file after passing the arguments if given. Print the new source 
to standard output.  

=cut

sub new_source($$) {
  my ($self, $path, $args) = @_;

  my $fpp = new Rinchi::Fortran::Preprocessor;
  $fpp->setHandlers('Start'      => \&_startElementHandler,
                  'End'        => \&_endElementHandler,
                  'Char'       => \&_characterDataHandler,
                  'Proc'       => \&_processingInstructionHandler,
                  'Comment'    => \&_commentHandler,
                  'CdataStart' => \&_startCdataHandler,
                  'CdataEnd'   => \&_endCdataHandler,
                  'XMLDecl'    => \&_xmlDeclHandler,
                  );

  if (defined($args) and ref($args) eq 'ARRAY') {
    $fpp->process_file($path,$args);
  } else {
    $fpp->process_file($path);
  }

}

# Preloaded methods go here.

1;
__END__