Help-Site Computer Manuals
Software
Hardware
Programming
Networking
  Algorithms & Data Structures   Programming Languages   Revision Control
  Protocols
  Cameras   Computers   Displays   Keyboards & Mice   Motherboards   Networking   Printers & Scanners   Storage
  Windows   Linux & Unix   Mac

B<PerlPoint::Generator::LANGUAGE::Formatter>
generates Formatter formatted LANGUAGE files

B<PerlPoint::Generator::LANGUAGE::Formatter> - generates Formatter formatted LANGUAGE files


NAME

PerlPoint::Generator::LANGUAGE::Formatter - generates Formatter formatted LANGUAGE files


VERSION

This manual describes version 0.01.


SYNOPSIS


DESCRIPTION




=head1 METHODS

new()




B<Parameters:>
class
The class name.

Returns: the new object.

Example:




=cut

sub new

 {

  # get parameter

  my ($class, %params)=@_;

  # check parameters

  confess "[BUG] Missing class name.\n" unless $class;

  confess "[BUG] Missing options hash.\n" unless exists $params{options};

  # build object

  my $me;

  $me=fields::new($class);

  # store options of interest (really necessary?)

  $me->{options}{$_}=$params{options}{$_}

   for grep(exists $params{options}{$_}, qw(

                                           ),

           );

  # supply new object

  $me;

 }



# provide option declarations

sub declareOptions

 {

  # get and check parameters

  (my __PACKAGE__ $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__);

  # start with the base options

  $me->readOptions($me->SUPER::declareOptions);

  # now add your own

  (

   [

    # TODO: add options used by this formatter, in Getopt::Long syntax.

    #       Remember to supply help for your options in help(), see below.

    "example=s",                 # an example option;

   ],

   # and base options that we ignore

   [

    # TODO: list options of base classes that become *invalid* by using this formatter.

    qw(

       baseexample

      ),

   ],

  );

 }



# provide help portions

sub help

 {

  # to get a flexible tool, help texts are supplied in portions

  {

   # supply the options part

   OPTIONS => {

               # TODO: supply help for all options that were added by this module

               #       (see declareOptions() above). Use the option name as keys

               #       and the help texts as values of your entries. You may embed

               #       POD markup, but please dont use headlines and lists.

               example => qq(an example option),

              },

   # supply synopsis part

   # TODO: add a *formatter specific* part of the SYNOPSIS that is displayed when

   #       a user specifies -help. Your part will be mixed with others, hierarchically.

   #       Make sure to check the result.

   SYNOPSIS => <<EOS,

According to your formatter choice, the LANGUAGE produced will be formatted by Formatter.

EOS } }




# provide source filter declarations

#

# TODO: adapt this method to reply a list of patterns for languages that can be embedded into

#       PerlPoint sources when using this formatter. Please note that both base classes can

#       provide a list already, which you might want to extend or restrict.

#

# OPTIONAL METHOD: if you don't want to modify the inherited list, just remove this method.

#       

sub sourceFilters

 {

  # get and check parameters

  (my __PACKAGE__ $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, replace a few items and provide the result

  (

   grep($_!~/^example$/i, $me->SUPER::sourceFilters),  # parent class list, but we do not support pure EXAMPLE

   "myown",                                            # embedded MYOWN;

  );

 }

# check usage sub checkUsage { # get and check parameters (my __PACKAGE__ $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__);


  # don't forget the base class (checks translations as well)

  $me->SUPER::checkUsage;

  # adapt tag translations (allows to use several standard XML converters)

  $me->{options}{tagtrans}=[

                            qw(

                               TABLE_COL:td

                               TABLE_HL:th

                               TABLE_ROW:tr

                               anchor:a

                               dlist:dl

                               dpointitem:dt

                               dpointtext:dd

                               example:pre

                               olist:ol

                               opoint:li

                               text:p

                               ulist:ul

                               upoint:li

                              )

                           ];

  # check your own options

  die "[Fatal] Please specify the name of the result file by -xmlfile.\n" unless exists $me->{options}{xmlfile};

  not -e $me->{options}{xmlfile} or -w _ or die "[Fatal] XML file $me->{options}{xmlfile} cannot be written.\n";

 }



# sub bootstrap

#  {

#   # get and check parameters

#   (my __PACKAGE__ $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__);

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

# initializations done when a backend is available sub initBackend { # get and check parameters (my __PACKAGE__ $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__);


  # don't forget the base class

  $me->SUPER::initBackend;

  # open result file

  my $handle=$me->{targethandle}=new IO::File(">$me->{options}{xmlfile}");

  # start the page

  # print $handle $me->{xml}->xmldecl({version => 1.0,});

  print $handle $me->{xml}->xmldtd(

                                   [

                                    # document type (needs to match the root element)

                                    'html',

                                    # external id

                                    qq(PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"),

                                    # DTD

                                    qq("http://www.w3c.org/TR/xhtml1/DTD/xhtml1-strict.dtd";),

                                   ]

                                  ), "\n\n";

 }

# headline formatter 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;


  # build the tag name and a path

  my $tag="h$item->{cfg}{data}{level}";

  my $path=$page->path(type=>'fpath', mode=>'full', delimiter=>'|');

  # build the headline, store it with anchors

  (

   $me->{xml}->a({name=>$item->{cfg}{data}{full}}),

   $path ne $item->{cfg}{data}{full} ? $me->{xml}->a({name=>$path}) : (),

   $me->{xml}->$tag(@{$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, @results)=('');

  # handle the various tags

  if ($item->{cfg}{data}{name} eq 'INDEX')

    {

     # scopies

     my (%index, %anchors);

     # index: get data structure

     my $anchors=$item->{cfg}{data}{options}{__anchors};

     # start with an anchor and a navigation bar ...

     push(@results, $me->{xml}->a({name=>(my $bar)=$me->{anchorfab}->generic}));

     push(@results, map {$anchors{$_}=$me->{anchorfab}->generic; $me->{xml}->a({href=>"#$anchors{$_}"}, $_)} sort keys %$anchors);

     # 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

        push(@results, $me->{xml}->p($me->{xml}->strong($me->{xml}->a({href=>"#$bar"}, $group))));

        # now add all the index entries

        push(

             @results, 

             $me->{xml}->div(

                             {class => 'indexgroup'},

                             map

                              {

                               (

                                # first, the entry string

                                $me->{xml}->div(

                                                {class => 'indexitem'},

                                                $_->[0],

                                               ),

                                # then, the list of occurences

                                $me->{xml}->div(

                                                {class => 'indexreflist'},

                                                map

                                                 {

                                                  # an occurence reference

                                                  $me->{xml}->a({href=>"#$_->[0]"}, $_->[1]),

                                                 } grep(ref($_), @{$_->[1]}) # TODO: check the structure! Why (doubled) scalars?

                                               ),

                               )

                              } @{$anchors->{$group}},

                            ),

            );

       }

    }

  elsif ($item->{cfg}{data}{name} eq 'L')

    {

     # link: build it

     @results=$me->{xml}->a(

                            {

                             href => $item->{cfg}{data}{options}{url},

                            },

                            @{$item->{parts}},

                           );

    }

  elsif ($item->{cfg}{data}{name} eq 'LOCALTOC')

    {

     # local toc: subchapters defined?

     if (exists $item->{cfg}{data}{options}{__rawtoc__} and @{$item->{cfg}{data}{options}{__rawtoc__}})

       {

        # get type flag, store it more readable

        my $plain=($item->{cfg}{data}{options}{type} eq 'plain');

        # make a temporary headline path array copy

        my @localHeadlinePath=@{$page->path(type=>'fpath', mode=>'array')};

        # prepare a subroutine to build links, if necessary

        my $link;

        unless ($plain)

          {

           $link=sub

                  {

                   # take parameters

                   my ($level, $title)=@_;

                   # update headline path (so that it describes the complete

                   # path of the future chapter then)

                   $localHeadlinePath[$level-1]=$title;

                   # supply the path of the upcoming chapter

                   @results=$me->{xml}->a(

                                          {

                                           href => join('', '#',

                                                        join('|',

                                                             map {defined($_) ? $_ : ''} @localHeadlinePath[0..$level-1],

                                                            ),

                                                       ),

                                          },

                                          $title,

                                         );

                  }

          }

        # use a more readable toc variable

        my $toc=$item->{cfg}{data}{options}{__rawtoc__};

        # make it a list of the requested format

        if ($item->{cfg}{data}{options}{format}=~/^(bullets|enumerated|numbers)$/)

          {

           # start a stack of intermediate level results

           my @buffered;

           # setup method name to build a (partial) list

           my $listMethodName=$item->{cfg}{data}{options}{format}=~/^(bullets|numbers)$/ ? 'ul' : 'ol';

           # make a temporary headline number array copy (used for numbered lists)

           my @localHeadlineNumbers=@{$page->path(type=>'npath', mode=>'array')};

           # calculate initial level depth for indentation (real headline levels should

           # not be reflected in a TOC listing them - a TOC *list* should start at level 1)

           my $startLevel=@localHeadlineNumbers;

           # traverse TOC entries

           foreach (@$toc)

             {

              # get level and title

              my ($level, $title)=@$_;

              # update headline numbering

              $localHeadlineNumbers[$level-1]++;

              # previous level closed?

              if ($level<@buffered)

                {

                 # complete closed levels and integrate them as lists

                 push(@{$buffered[$_-1]}, $me->{xml}->$listMethodName(@{$buffered[$_]})),

                   for reverse $level..@buffered-1;

                 

                 # delete all buffer levels which were integrated,

                 # delete headline numbers of the levels that were closed

                 $#buffered=$#localHeadlineNumbers=$level-1;

                }

              # buffer item on current level

              push(@{$buffered[$level-1]}, $me->{xml}->li(

                                                          # write numbers if we are building a numbered lists

                                                          $item->{cfg}{data}{options}{format} eq 'numbers' ? join('', join('.', @localHeadlineNumbers[0..$level-1]), '. ') : (),

                                                          $plain ? $title : $link->(@$_)

                                                         )

                  );

             }

           # close open lists (down to the initial level depth)

           push(@{$buffered[$_-1]}, $me->{xml}->$listMethodName(@{$buffered[$_]})),

             for reverse $startLevel+1 .. @buffered-1;

           # finally, build the list (on startup level), including nested lists eventually

           @results=$me->{xml}->$listMethodName(@{$buffered[$startLevel]});

          }

        else

          {die "[BUG] Unhandled case $item->{cfg}{data}{options}{format}."}

       }

     else

       {

        # oops - there are no subchapters

        @results=();

       }

    }

  elsif ($item->{cfg}{data}{name} eq 'REF')

    {

     # scopies

     my ($label);

     # catch target

     my $target=$item->{cfg}{data}{options}{name};

     # get the upcoming chapters data

     my @chapters=$me->getChapterByPath($target);

     # Anything found? Otherwise search for an anchor of the target name and get its page data

     unless ($chapters[0][0])

       {

        # get value and page

        my $data=$me->getAnchorData($target);

        # anything found?

        if (defined $data)

          {

           # get chapter data

           @chapters=$me->getChapterByPagenr($data->[1]);

           # set up local link

           $label=$target;

          }

       }

     # build text to display: is there a body?

     if ($item->{cfg}{data}{options}{__body__})

       {

        # yes: the tag body is our text

        @results=@{$item->{parts}};

       }

     else

       {

        # no body: what we display depends on option "valueformat"

        if ($item->{cfg}{data}{options}{valueformat} eq 'pure')

          {

           # display the value of the requested object

           @results=$item->{cfg}{data}{options}{__value__};

          }

        elsif ($item->{cfg}{data}{options}{valueformat} eq 'pagetitle')

          {

           # display the objects page title, to be found in target data

           @results=$chapters[0][2];

          }

        elsif ($item->{cfg}{data}{options}{valueformat} eq 'pagenr')

          {

           # display the objects page number (for more generic or configurable numbers,

           # this could be done by a function)

           @results=join('.', @{$chapters[0][7]}, '');

          }

        else

          {die "[BUG] Unhandled case $item->{cfg}{data}{options}{valueformat}."}

       }

     # if we do not build a link, we are already done now, otherwise, we have to

     # add link syntax

     if ($item->{cfg}{data}{options}{type} eq 'linked')

       {

        # build target chapter file name, using the absolute page number

        my $link=$me->_buildFilename($chapters[0][0]);

        # add lokal link, if necessary

        $link=join('#', $link, $label) if $label;

        # now build the link

        @results=$me->{xml}->a({href => $link}, @results);

       }

    }

  elsif ($item->{cfg}{data}{name} eq 'SEQ')

    {

     # sequence: pure text for now, possibly anchored

     # (what's best to keep the sequence type?)

     if (exists $item->{cfg}{data}{options}{name})

       {

        @results=$me->{xml}->A(

                               {

                                name => $item->{cfg}{data}{options}{name},

                               },

                               $item->{cfg}{data}{options}{__nr__},

                              );

       }

     else

       {@results=$item->{cfg}{data}{options}{__nr__};}

    }

  elsif ($item->{cfg}{data}{name} eq 'TABLE')

    {

     # build the table

     @results=$me->{xml}->table(@{$item->{parts}});

    }

  elsif ($item->{cfg}{data}{name} eq 'TABLE_COL')

    {

     # build the cell

     @results=$me->{xml}->td(

                             {

                             },

                             @{$item->{parts}} ? @{$item->{parts}} : '&nbsp;'

                            );

    }

  elsif ($item->{cfg}{data}{name} eq 'X')

    {

     # index entry: transform it into an anchor

     @results=$me->{xml}->a(

                            {

                             name => $item->{cfg}{data}{options}{__anchor},

                            },

                            @{$item->{parts}},

                           );

    }

  else

    {

     # invoke base method

     return $me->SUPER::formatTag(@_[1..$#_]);

    }

  # supply results

  # warn @results;

  @results;

 }



# docstream entry formatter

sub formatDStreamEntrypoint

 {

  # 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 $item;

  # provide the parts

  $me->{xml}->div({class=>$item->{cfg}{data}{name}}, @{$item->{parts}});

 }

# docstream frame formatter sub formatDStreamFrame { # 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 $item;


  # provide the parts

  $me->{xml}->div({class=>'streamFrame'}, @{$item->{parts}});

 }



# page formatter

sub formatPage

 {

  # 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 $item;

  # store this slide - note that there is no frame in XHTML,

  # a slide just starts with its headline

  push(@{$me->{slides}}, @{$item->{parts}})

    if @{$item->{parts}} and grep(ref($_)!~/::comment$/, @{$item->{parts}});

  # supply nothing directly

  '';

 }

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


  # don't forget the base class

  $me->SUPER::finish;

  # write document

  my ($handle)=($me->{targethandle});

  print $handle $me->{xml}->html(

                                 {

                                  #xmlns      => qq("http://www.w3c.org/1999/xhtml";),

                                  #'xml:lang' => qq("en"),

                                  #lang       => qq("en"),

                                 },

                                 # add meta data part

                                 $me->{xml}->head(

                                                  # title (mandatory) ...

                                                  $me->{xml}->title($me->{options}{doctitle}),

                                                  # stylesheets

                                                  exists $me->{options}{css} ? map

                                                   {

                                                    # extract title and filename

                                                    my ($file, $title)=split(':', $me->{options}{css}[$_], 2);

                                                    $title="unnamed $_" if $_ and not $title;

                                                    $me->{xml}->link(

                                                                     {

                                                                      href => $file,

                                                                      $_ ? (title=>$title) : (), 

                                                                      rel  => $_<2 ? 'stylesheet' : 'alternate stylesheet',

                                                                      type => 'text/css',

                                                                     },

                                                                    )

                                                    } 0..$#{$me->{options}{css}} : (),

                                                  # the "doc..." options are reserved for further data

                                                  # ... stored in meta tags

                                                  map

                                                   {

                                                    /^doc(.+)$/;

                                                    my $tag=$me->elementName("_$1");

                                                    $me->{xml}->meta({name=>$tag, contents=>$me->{options}{$_}}),

                                                   } sort grep((/^doc/ and not /^doctitle/), keys %{$me->{options}}),

                                                 ),

                                 # embed slides into a special section

                                 $me->{xml}->body(@{$me->{slides}}),

                                ), "\n\n";



  # close document

  close($handle);

 }



# flag successfull loading

1;



# = POD TRAILER SECTION =================================================================


NOTES




=head1 SEE ALSO
Base formatters
This formatter inherits from PerlPoint::Generator and PerlPoint::Generator::XML.




=head1 SUPPORT

A PerlPoint mailing list is set up to discuss usage, ideas, bugs, suggestions and translator development. To subscribe, please send an empty message to perlpoint-subscribe@perl.org.

If you prefer, you can contact me via perl@jochen-stenzel.de as well.


AUTHOR

Copyright (c) Jochen Stenzel (perl@jochen-stenzel.de), 2003-2004. All rights reserved.

This module is free software, you can redistribute it and/or modify it under the terms of the Artistic License distributed with Perl version 5.003 or (at your option) any later version. Please refer to the Artistic License that came with your Perl distribution for more details.

The Artistic License should have been included in your distribution of Perl. It resides in the file named ``Artistic'' at the top-level of the Perl source tree (where Perl was downloaded/unpacked - ask your system administrator if you dont know where this is). Alternatively, the current version of the Artistic License distributed with Perl can be viewed on-line on the World-Wide Web (WWW) from the following URL: http://www.perl.com/perl/misc/Artistic.html




=head1 DISCLAIMER

This software is distributed in the hope that it will be useful, but is provided ``AS IS'' WITHOUT WARRANTY OF ANY KIND, either expressed or implied, INCLUDING, without limitation, the implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR PURPOSE.

The ENTIRE RISK as to the quality and performance of the software IS WITH YOU (the holder of the software). Should the software prove defective, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

IN NO EVENT WILL ANY COPYRIGHT HOLDER OR ANY OTHER PARTY WHO MAY CREATE, MODIFY, OR DISTRIBUTE THE SOFTWARE BE LIABLE OR RESPONSIBLE TO YOU OR TO ANY OTHER ENTITY FOR ANY KIND OF DAMAGES (no matter how awful - not even if they arise from known or unknown flaws in the software).

Please refer to the Artistic License that came with your Perl distribution for more details.

Programminig
Wy
Wy
yW
Wy
Programming
Wy
Wy
Wy
Wy