view release on metacpan or  search on metacpan

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

   # new options
   [],

   # there is no base option that we ignore
   [],
  );
 }


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

  # to get a flexible tool, help texts are supplied in portions
  {
   # supply the options part
   OPTIONS => {
              },

   # supply synopsis part
   SYNOPSIS => <<EOS,

In your case, you want to produce SDF.

EOS
  };
 }


# provide source filter declarations
sub sourceFilters
 {
  # get and check parameters
  my ($me)=@_;
  confess "[BUG] Missing object parameter.\n" unless $me;
  confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);

  # get the common parent class list, add a few items and provide the result
  (
   $me->SUPER::sourceFilters,  # parent class list
   "sdf",                      # embedded SDF;
   "html",                     # embedded HTML (sdf can handle it);
  );
 }


# formatters

sub preFormatter
 {
  # get and check parameters
  my ($me, $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__);

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

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

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

sub formatSimple
 {
  # get and check parameters
  my ($me, $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}{sdf})
    {
     # Guard translations of things like "\B<{key=>value}>" by translating "{".
     # *Opening* curly braces might confuse SDF as well (unless corresponding
     # closing braces will follow).
     $result=~s/([{}])/$curlyBraceTranslations{$1}/g;

     # brackets seem to have a special meaning in SDF,
     # (sdf evaluates their contents via eval()), so guard them
     $result=~s/\[/\\[/g
      if grep(($_ eq DIRECTIVE_BLOCK or $_ eq DIRECTIVE_VERBATIM), @{$item->{context}});
    }

  # replace more characters which may confuse sdf, except where they are intended
  # (but not intended to confuse ;-)
  unless (grep($_ eq DIRECTIVE_VERBATIM, @{$item->{context}}) or $me->{flags}{sdf} or $me->{flags}{html})
    {
     $result=~s/</{{CHAR:lt}}/g;
     $result=~s/>/{{CHAR:gt}}/g;
    }

  # supply result
  $result;
 }

sub formatHeadline
 {
  # get and check parameters
  my ($me, $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 path

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

  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;

  # pass over to a generalized method
  shift;
  $me->_formatExample('>', @_);
 }

sub _formatExample
 {
  # get and check parameters
  my ($me, $prefix, $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;

  # remove empty lines at begin and end and a final newline at the end of the block
  shift(@{$item->{parts}}) while $item->{parts}[0]=~/\s*^$/;
  pop(@{$item->{parts}}) while $item->{parts}[-1]=~/\s*^$/;
  chomp($item->{parts}[-1]);

  # format example block
  join('',
       "\n\n$prefix",
       (
        map {
             s/\n/\n$prefix/g;
             $_        
            } @{$item->{parts}},
       ),
       "\n\n",
      );
 }


sub formatTag
 {
  # get and check parameters
  my ($me, $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, $result)=('');

  # handle the various tags
  if (exists $simpleTags{$item->{cfg}{data}{name}})
    {
     $directive=$simpleTags{$item->{cfg}{data}{name}};
     $result=join('', "{{$directive:", @{$item->{parts}}, '}}');
    }
  elsif ($item->{cfg}{data}{name} eq 'A')
    {
     # anchor: build result string
     $result=join('', qq({{N[id=q($item->{cfg}{data}{options}{name})]), @{$item->{parts}}, '}}');
    }
  elsif ($item->{cfg}{data}{name} eq 'EMBED')
    {
     # embedded part: SDF is prepared for printing
     if ($item->{cfg}{data}{options}{lang}=~/^SDF$/i)
       {
        # just concatenate the parts
        $result=join('', @{$item->{parts}});
       }
     elsif ($item->{cfg}{data}{options}{lang}=~/^HTML$/i)
       {
        # concatenate first ...
        $result=join('', @{$item->{parts}});

        # then inline as possible
        my $newlines=$result=~/\n/;
        $result=join('',
                     $newlines ? "\n!block inline\n" : "{{INLINE:",
                     $result,
                     $newlines ? "\n!endblock\n"     : "}}",
                    );
       }
    }
  elsif ($item->{cfg}{data}{name} eq 'FORMAT')
    {
     # formatting: all we have to do is to store informations
     $result='';

     # 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';
    }
  elsif ($item->{cfg}{data}{name} eq 'IMAGE')
    {
     # image: parse image path
     my @image=fileparse($item->{cfg}{data}{options}{src});
     
     # build result string
     $result=join('', qq(\n\n!import "$image[0]"; ), $image[1] ? qq(base="$image[1]"; ) : '', join('; ', map {join('=', $_, map {/\s/ ? "\"$_\"" : $_} ucfirst(lc($item->{cfg}{data}{options}{$_})))} grep(lc($_)!~/^(src|__loaderpath__)$/, keys %{$item-...
    }
  elsif ($item->{cfg}{data}{name} eq 'INDEX')
    {
     # scopies
     my (%index);

     # index: get data structure
     my $anchors=$item->{cfg}{data}{options}{__anchors};

     # start with an anchor and a navigation bar ...
     $result=join('', "{{N[id=q(", (my $bar)=$me->{anchorfab}->generic, ")]");
     $result.=join(' ', map {join('', "{{CMD[jump=q(#", $me->{anchorfab}->generic, ")]$_}}")} sort keys %$anchors);
     $result.="}}\n\n";

     # now, traverse all groups and build their index
     foreach my $group (sort keys %$anchors)
       {
        # make the character a "headline", linking back to the navigation bar
        $result.=join('', "{{B:{{CMD[jump=q(#$bar)]$group}}}}\n\n");

        # now add all the index entries