view release on metacpan or  search on metacpan

lib/PerlPoint/Generator/XML.pm  view on Meta::CPAN

  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);

  # don't forget the base class
  $me->SUPER::bootstrap;

  # take tag translations
  my $error=0;
  foreach my $option (@{$me->{options}{tagtrans}})
    {
     # check format, extract parts
     unless ($option=~/$patternTagTrans/)
      {die qq([Error] Wrong format in targ translation "$option": use "<PerlPoint tag>:<XML tag>".\n);}
     else
      {
       # check tag
       warn (qq([Warn] Unknown PerlPoint tag "$1" in tag translation "$option".\n)),
        $error=1,
        unless exists $xmltags{$1};
      }

     # store translation
     $xmltags{$1}=$2;
    }

  #check success
  die "\n" if $error;

  # write DTD, if requested
  if (exists $me->{options}{writedtd})
    {
     # open DTD
     open(DTD, ">$me->{options}{xmldtd}") or die "[Fatal] Could not open DTD file $me->{options}{xmldtd} for writing: $!";

     # get template
     my $template=join('', <DATA>);

     # transform it to the current tag names
     $template=~s/=$_=/$xmltags{$_}/g for keys %xmltags;

     # write DTD
     print DTD $template;

     # close DTD
     close(DTD);
    }
 }


# formatters
sub preFormatter
 {
  # get and check parameters
  ((my __PACKAGE__ $me), my ($opcode, $mode, @more))=@_;
  confess "[BUG] Missing object parameter.\n" unless $me;
  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);

  # invoke base class method, if necessary
  $me->SUPER::preFormatter() if $me->can('SUPER::preFormatter');

  # embed tag?
  if ($opcode==DIRECTIVE_TAG and $more[0] eq 'EMBED')
    {
     # get more parameters
     my ($tag, $settings)=@more;

     # embedded XML configuration
     $me->{flags}{xml}=($mode==DIRECTIVE_START) ? 1 : 0 if $settings->{lang}=~/^xml$/i;
    }

  # a paragraph enforcing plain XML without formatting (newlines added for pretty printing)?
  elsif (
            $opcode==DIRECTIVE_TEXT
         or $opcode==DIRECTIVE_BLOCK
         or $opcode==DIRECTIVE_VERBATIM
        )
    {
     # act mode dependend
     $me->{xmlmode}=$mode==DIRECTIVE_START ? 'xmlplain' : 'xml';
    }
 }

sub formatSimple
 {
  # get and check parameters
  ((my __PACKAGE__ $me), my ($page, $item))=@_;
  confess "[BUG] Missing object parameter.\n" unless $me;
  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
  confess "[BUG] Missing page data parameter.\n" unless $page;
  confess "[BUG] Missing item parameter.\n" unless defined $item;

  # the base operation is to concatenate the parts
  my $result=join('', @{$item->{parts}});

  # now we have to check for special operations to perform
  unless ($me->{flags}{xml})
    {
    }

  # supply result
  $result;
 }

sub formatHeadline
 {
  # get and check parameters
  ((my __PACKAGE__ $me), my ($page, $item))=@_;
  confess "[BUG] Missing object parameter.\n" unless $me;
  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
  confess "[BUG] Missing page data parameter.\n" unless $page;
  confess "[BUG] Missing item parameter.\n" unless defined $item;

  # get the tag name
  my $xmltag=$xmltags{headline};

  # build the headline
  $me->{xml}->$xmltag(
                      {
                       level    => $item->{cfg}{data}{level},
                       full     => $item->{cfg}{data}{full},
                       abbr     => $item->{cfg}{data}{abbr},
                       path     => $page->path(type=>'fpath', mode=>'full', delimiter=>'|'),

lib/PerlPoint/Generator/XML.pm  view on Meta::CPAN

  # get the tag name
  my $xmltag=$xmltags{example};

  # build option hash
  my %options;
  $me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');

  # provide the parts, take care to begin the example in a *new* line
  # (after the tag opener)
  $me->{xmlplain}->$xmltag(\%options, "\n", @{$item->{parts}});
 }


sub formatVerbatim
 {
  # get and check parameters
  ((my __PACKAGE__ $me), my ($page, $item))=@_;
  confess "[BUG] Missing object parameter.\n" unless $me;
  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
  confess "[BUG] Missing page data parameter.\n" unless $page;
  confess "[BUG] Missing item parameter.\n" unless defined $item;

  # get the tag name
  my $xmltag=$xmltags{example};

  # build option hash
  my %options;
  $me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');

  # provide the parts
  $me->{xmlplain}->$xmltag(\%options, @{$item->{parts}});
 }

# tag formatter
sub formatTag
 {
  # get and check parameters
  ((my __PACKAGE__ $me), my ($page, $item))=@_;
  confess "[BUG] Missing object parameter.\n" unless $me;
  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
  confess "[BUG] Missing page data parameter.\n" unless $page;
  confess "[BUG] Missing item parameter.\n" unless defined $item;

  # declarations
  my ($directive, $xmltag, $result)=('');

  # handle the various tags
  if ($item->{cfg}{data}{name} eq 'A')
    {
     # anchor: build result string
     $xmltag=$xmltags{A};
     confess "[BUG] No tag found" unless $xmltag;
     $result=$me->{$me->{xmlmode}}->$xmltag(
                                            {
                                             name => $item->{cfg}{data}{options}{name},
                                            },
                                            @{$item->{parts}},
                                           );

    }
  elsif ($item->{cfg}{data}{name} eq 'EMBED')
    {
     # embedded XML
     if ($item->{cfg}{data}{options}{lang}=~/^XML$/i)
       {
        # just concatenate the parts (and supply them as XML::Generator object, not as string)
        my $pseudotag="embedded-$item->{cfg}{data}{options}{lang}";
        $result=$me->{xmlready}->$pseudotag(@{$item->{parts}});
       }
    }
  elsif ($item->{cfg}{data}{name} eq 'FORMAT')
    {
     # formatting: all we have to do is to store informations
     $result='';

     # justification: store what we got
     $item->{cfg}{data}{options}{align}=ucfirst(lc($item->{cfg}{data}{options}{align}));
     $item->{cfg}{data}{options}{align}='Full' if $item->{cfg}{data}{options}{align} eq 'Justify';
     $me->{flags}{align}=$item->{cfg}{data}{options}{align} if $item->{cfg}{data}{options}{align}=~/^(Left|Full|Center|Right)$/;
     delete $me->{flags}{align} if $item->{cfg}{data}{options}{align} eq 'Default';

     # handle transition settings
     if (exists $item->{cfg}{data}{options}{transition})
       {
        # get setting
        my $transition=$item->{cfg}{data}{options}{transition}!~/^reset$/i ? $item->{cfg}{data}{options}{transition} : undef;

        # update transition settings for all the items that are listed,
        # or in general if no certain item is mentioned
        foreach my $target (qw(slides bullets images blocks verbatims))
          {
           $me->{cfg}{XML}{transition}{$target}=$transition
             if     not exists $item->{cfg}{data}{options}{items}
                or $item->{cfg}{data}{options}{items}=~/(^|(\s*,\s*))$target((\s*,\s*)|$)/i;
          }
       }
    }
  elsif ($item->{cfg}{data}{name} eq 'IMAGE')
    {
     # get a local option copy
     my %options=%{$item->{cfg}{data}{options}};

     # image: parse image path
     my ($base, $path)=fileparse($options{src});

     # replace image source path by required reference path
     $options{src}="$me->{options}{imageref}/$base";

     # get tag name
     $xmltag=$xmltags{$item->{cfg}{data}{name}};

     # build and init option hash
     %options=map {$_, map {/\s/ ? "\"$_\"" : $_} $options{$_}} grep(lc($_)!~/^(__loaderpath__)$/, keys %options);
     $me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');

     # build result string
     $result=$me->{$me->{xmlmode}}->$xmltag(\%options);
    }
  elsif ($item->{cfg}{data}{name} eq 'INDEX')
    {
     # scopies