ServDoc_ascii

Code Index:



NAME

ServDoc_ascii - turn output of ServDoc modules in something readable


VERSION

$Id: ServDoc_ascii,v 1.5 2004/01/03 20:43:25 uherbst Exp $


SYNOPSIS

ServDoc_ascii [-h|help] [-v|version] [--debug ASCII,intensity]


DESCRIPTION

ServDoc_ascii reads the collected output from different ServDoc modules from STDIN and tries to put that in a readable ASCII Format

Every Headline in the input becomes a ASCII-Headline, underlined with a char from @underline_char (headline level 1 takes $underline_char[0], headline level2 takes $underline_char[1] and so on).


OPTIONS

-h|help
This help.

-v|version
Version

--debug ASCII,intensity
Turn on Debugging for that module.

The debug feature for that module is named ``ASCII''.


AUTHORS

Ulrich Herbst <Ulrich.Herbst@gmx.de>


#!/usr/bin/perl

#----------------------------------------------------------------------

# standard perl modules
use strict;                       # print error about unknown variables ...
use English;                      # long internal variable names;
use FindBin;                      # In which directory is ServDoc itself ?
                                  # There has to be the module and the lib dir!
use lib $FindBin::Bin. "/lib";    # Here are the ServDoc-perl-modules

# our own perl modules
use ServDoc;
use ServDocOutput;
use XML::Simple::PurePerl;

#----------------------------------------------------------------------

my $options;
$options->{Version} =
  '$Id: ServDoc_ascii,v 1.5 2004/01/03 20:43:25 uherbst Exp $';

# We need the cmdline to call the modules with the same debug options.
$options->{cmdline} = join " ", @ARGV;

sub debug { ServDoc_debug( "ASCII", $options, shift, shift ); }

$options = &process_cmdline($options);
debug( 9, "ServDoc_ascii is running" );

#----------------------------------------------------------------------

# Main

# Edit that to suite your needs.
my @underline_char =
  ( '=', '+', '-', '.', '.', '.', '.', '.', '.', '.', '.', '.', '.' );

my @last_headings = ('');

# Inputs are on STDIN
my $xmldata=join "",<STDIN>;
my $xmltree=XMLin($xmldata,keyattr=>"",forcearray=>1,forcecontent=>1);

for (my $i=0; $i<=$#{@{$xmltree->{SDitem}}}; $i++) {

  my ($short_desc,$long_desc,$text,$tableref,@headings)
    = get_and_normalize_SDitem_data($xmltree->{SDitem}->[$i]);

  $short_desc = replace_html_entities($short_desc);
  $long_desc  = replace_html_entities($long_desc);
  $text       = replace_html_entities($text);

  my $heading_equal;
  for ( $heading_equal = 0 ; $heading_equal <= $#headings ; $heading_equal++ )
  {
    if ( $last_headings[$heading_equal] ne $headings[$heading_equal] ) {
      last;
    }
  }

  # in $heading_equal is the number of the first unequal heading
  # between the new "@headings" and the headings from the last line;
  $#last_headings = $heading_equal;

  for ( my $x = $heading_equal ; $x < $#headings ; $x++ ) {
    print "$headings[$x]\n";
    print $underline_char[$x] x length( $headings[$x] ) . "\n\n";
    $last_headings[$x] = $headings[$x];
  }

  print "$headings[-1]\n";
  print $underline_char[$#headings] x length( $headings[-1] ) . "\n\n";

  print "$short_desc\n$long_desc\n";

  print "-" x 5 . "\n";

  # Are there tables to output ?
  if (ref($tableref) eq "ARRAY") {
    make_table($tableref->[0]);
  }

  print "$text\n\n";
}

# make a ASCII-Table:
sub make_table {
  my $ref = shift;

  # First, we put the whole table in a 2d array.
  # Then we output that array (and we look for the longest string in a
  # array cell.
  # $array[$row][$column]

  my @array;
  my $row;
  my $column;
  for ($row=0; $row<=$#{@{$ref->{'tr'}}};$row++) {
    for ($column=0; $column <=$#{@{$ref->{'tr'}->[$row]->{th}}}; $column++) {
      $array[$row][$column]
        =
      replace_html_entities($ref->{'tr'}->[$row]->{th}->[$column]->{content});
    };
    for ($column=0; $column <=$#{@{$ref->{'tr'}->[$row]->{td}}}; $column++) {
      $array[$row][$column]
        =
      replace_html_entities($ref->{'tr'}->[$row]->{td}->[$column]->{content});
    };
  }; # rows

  # What is the max length for every column ?
  my @maxlength;
  for ($column=0; $column<=$#{@array[0]}; $column++) {
    my $max=length($array[0][$column]);
    for ($row=1; $row<=$#array; $row++) {
      if (length($array[$row][$column]) > $max) {
	$max=length($array[$row][$column]);}
    }
    push @maxlength,$max+1;
  }
	  
  # Output @array
  for ($row=0; $row <= $#array; $row++) {
    for ($column=0; $column <=$#{@array[0]};$column++) {
      printf "%-$maxlength[$column]s",$array[$row][$column] . " "; }
    print "\n";}
  
}

sub replace_html_entities {
  my $text = shift;

  # Replace HTML Entities with Special chars.
  $text =~ s/&auml;/ä/g;
  $text =~ s/&Auml;/Ä/g;
  $text =~ s/&ouml;/ö/g;
  $text =~ s/&Ouml;/Ö/g;
  $text =~ s/&uuml;/ü/g;
  $text =~ s/&Uuml;/Ü/g;
  $text =~ s/&szlig;/ß/g;

  return $text;
}