view release on metacpan or  search on metacpan

lib/FrameMaker/MifTree.pm  view on Meta::CPAN

the allowed structures (within their contexts) and attribute types. The file
FrameMaker/MifTree/MifTreeTags holds all the valid MIF statements and the
attribute type for every statement. This file may need some improvement, as it
is created by analyzing a large collection of MIF files written by FrameMaker
(and an automatic analysis of the I<MIF Reference>, which showed several typos
and inconsistencies in that manual). The current file is for MIF version 7.00.

=head2 Dependencies

This class implementation depends on the following modules, all available from
CPAN:

=over 4

=item *

Tree::DAG_Node

=item *

IO::Tokenized and IO::Tokenized::File and the custom-made IO::Tokenized::Scalar

=item *

IO::Stringy (only IO::Scalar is needed)

=back

=cut

BEGIN {
  use Exporter ();
  our $VERSION     = 0.075;
  our @ISA         = qw(Tree::DAG_Node Exporter);
  our @EXPORT      = qw(&quote &unquote &encode_path &decode_path &convert);
  our @EXPORT_OK   = qw(%fmcharset %fmnamedchars);
  our %EXPORT_TAGS = ();
}
our @EXPORT_OK;

our (%mifnodes, %mifleaves, %attribute_types, %fmcharset, %fmnamedchars);

our $use_unicode;

for my $do (qw(FrameMaker/MifTree/MifTreeTags FrameMaker/MifTree/FmCharset)) {
  do $do or croak $! || $@;
}
our $fm_to_unicode = '$s =~ tr/' .
  join('', map { sprintf '\x%02x',   ord } keys   %fmcharset) . '/' .
  join('', map { sprintf '\x{%04x}', ord } values %fmcharset) . '/';
our $unicode_to_fm = '$s =~ tr/' .
  join('', map { sprintf '\x{%04x}', ord } values %fmcharset) . '/' .
  join('', map { sprintf '\x%02x',   ord } keys   %fmcharset) . '/';

our $default_unit = '';
our @parserdefinition = (
  [ COMMENT => qr/#.*/ ],
  [ RANGLE  => qr/>/, sub{''} ],
  [ MIFTAG  => qr/<\s*[a-z][a-z0-9]*/i, sub {(my $m = shift) =~ s/^<//; $m;} ],
  [ ATTRIBS => qr/`.*?'|[^=&>#]+/ ],
  [ FACET   => qr/[=&].+/ ],
  [ MACRO   => qr/define\s*\(.*?\)/ ]
);
our %unit_to_factor = (
  ''         => 1 / 72,
  pt         => 1 / 72,
  point      => 1 / 72,
  q(")       => 1,
  in         => 1,
  mm         => 1 / 25.4,
  millimeter => 1 / 25.4,
  cm         => 1 / 2.54,
  centimeter => 1 / 2.54,
  pc         => 1 / 6,
  pica       => 1 / 6,
  dd         => 0.01483,
  didot      => 0.01483,
  cc         => 12 * 0.01483,
  cicero     => 12 * 0.01483
);

=head2 Overridden Methods

=over 4

=item C<add_daughters(LIST)>

Adds a list of daughter object to a node. The difference with the DAG_Node
method is that it checks for a valid MIF construct. Only the mother/daughter
relationship is checked.

=cut

sub add_daughters {
  # extends functionality of Tree::DAG_Node's sub
  my($mother, @daughters) = @_;

  if (ref $mother && $mother->name) { # only when called on object and if
                                      # we know the name of the mother
    # check for allowed daughters
    if (warnings::enabled || $^W) {
      for my $daughter (@daughters) {
        warnings::warn 'Node "' . ($mother->name || '') .
          '" does not allow daughter "' . ($daughter->name || '') . '"'
          unless $mother->allows_daughter($daughter);
      }
    }
  }

  $mother->SUPER::add_daughters(@daughters);
}

=item C<attributes(VALUE)>

The attributes method of the FrameMaker::MifTree class does not require a
reference as an attribute, as does the DAG_Node equivalent. As an extra, the
method checks if the method is called on a leaf, since the MIF structure does
not allow attributes on non-ending nodes. The method reads/sets the raw
attribute, no string conversion, path encoding/decoding or value extraction is
done. To obtain or set one of those values, use the specific L<Attribute
Methods> mentioned below.

lib/FrameMaker/MifTree.pm  view on Meta::CPAN

        }
      } else {
        print $MIF "# End of MIFFile\n";
      }
    }
  });
  return 1;
}

=item C<$OBJ-E<gt>parse_mif(STRING)>

Parses a string of MIF statements into the object. This is also a very quick
way to set up an object tree:

  my $new_obj = FrameMaker::MifTree->new();
  $new_obj->parse_mif(<<ENDMIF);
  <MIFFile 7.00># The only required statement
  <Para # Begin a paragraph
  <ParaLine# Begin a line within the paragraph
  <String `Hello World'># The actual text of this document
  > # end of Paraline #End of ParaLine statement
  > # end of Para #End of Para statement
  ENDMIF

Implemented by tying the scalar to a filehandle and calling IO::Tokenizer on
the resulting handle.

The parser currently has the following limitations:

=over 8

=item *

All comments are lost.

=item *

Macro statements are not (yet) implemented.

=item *

Include statements are not (yet) implemented.

=back

Maybe I'll do something about it. Someday.

=cut

sub parse_mif {
  my ($obj, $string) = @_[0, 1];
  my $class = ref($obj) || croak 'Must be called on object';
  my $facet_handle = 0;

  my $fh = IO::Tokenized::Scalar->new();
  $fh->setparser(@parserdefinition);
  $fh->open(\$string);

  my $cur_obj = $obj;
  while ( my ($tok, $val) = $fh->gettoken ) {
    if ( $tok eq 'FACET' ) {
      unless ($facet_handle) {
        $cur_obj->add_facet;
        $facet_handle = $cur_obj->facet_handle;
      }
      syswrite $facet_handle, "$val\n";
    } else {
      $facet_handle = 0;
      if ( $tok eq 'MIFTAG' ) {
        $cur_obj = $cur_obj->add_node($val);
      } elsif ( $tok eq 'RANGLE' ) {
        $cur_obj = $cur_obj->mother;
      } elsif ( $tok eq 'ATTRIBS' ) {
        if (defined $cur_obj->attributes) {
          $cur_obj->attributes($cur_obj->attributes . $val)
        } else {
          $cur_obj->attributes($val)
        }
      }
    }
  }
  $fh->close;
}

=item C<$OBJ-E<gt>parse_miffile(FILENAME)>

Parses a file from disk into a DAG_Node tree structure. See L<parse_mif> for
details.

=cut

sub parse_miffile {
  my ($obj, $filename) = @_[0, 1];
  croak qq(File "$filename" not found) unless -f $filename;
  my $class = ref($obj) || croak 'Must be called on object';
  my $facet_handle = 0;

  my $fh = IO::Tokenized::File->new();
  $fh->setparser(@parserdefinition);
  $fh->buffer_space(524_288);
  $fh->open($filename);

  my $cur_obj = $obj;
  while ( my ($tok, $val) = $fh->gettoken ) {
    if ( $tok eq 'FACET' ) {
      unless ($facet_handle) {
        $cur_obj->add_facet;
        $facet_handle = $cur_obj->facet_handle;
      }
      syswrite $facet_handle, "$val\n";
    } else {
      $facet_handle = 0;
      if ( $tok eq 'MIFTAG' ) {
        $cur_obj = $cur_obj->add_node($val);
      } elsif ( $tok eq 'RANGLE' ) {
        $cur_obj = $cur_obj->mother;
      } elsif ( $tok eq 'ATTRIBS' ) {
        if (defined $cur_obj->attributes) {
          $cur_obj->attributes($cur_obj->attributes . $val)
        } else {
          $cur_obj->attributes($val)
        }
      }
    }
  }
  $fh->close;
}

=back

=head2 Old-style Functions

All these functions are exported by default.

=over 4

=item C<quote(STRING)>

Quotes a string with MIF style quotes, and escapes forbidden characters.
Backslashes, backticks, single quotes, greater-than and tabs are escaped,
non-ASCII values are written in their hexadecimal representation. So:

Some `symbols': E<gt> \E<216>E<191>!>

is written as

  `Some \Qsymbols\q: \> \\\xaf \xc0 !'

As a special case, escaped hexadecimals are preserved in the input string. If
you want a literal \x00 string, precede it with an extra backslash.

  print quote("\x09 ");     # prints `\x09 ', a forced return in FrameMaker
  print quote("\\x09 ");    # prints `\\x09 '; this will show up literally
                            # as \x09 in FrameMaker

(Note that after emitting a forced return, you I<must> start a new ParaLine.)

If the global modifier $FrameMaker::MifTree::use_unicode is true, the string
will be converted from Unicode to the FrameMaker character set.


=cut

sub quote {
  my ($s, $use_unicode_deprecated) = @_;