view release on metacpan or  search on metacpan

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

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,

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

  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' ) {

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

  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' ) {