#!/usr/bin/perl

# The LearningOnline Network with CAPA
# piml_parse.pl - Linux Packaging Markup Language parser
#
# $Id: piml_parse.pl,v 1.1 2002/01/29 10:43:02 harris41 Exp $
#
# Written by Scott Harrison, harris41@msu.edu
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# YEAR=2002
# 1/28 - Scott Harrison
#
###

###############################################################################
##                                                                           ##
## ORGANIZATION OF THIS PERL SCRIPT                                          ##
## 1. Notes                                                                  ##
## 2. Get command line arguments                                             ##
## 3. First pass through (grab distribution-specific information)            ##
## 4. Second pass through (parse out what is not necessary)                  ##
## 5. Third pass through (translate markup according to specified mode)      ##
## 6. Functions (most all just format contents of different markup tags)     ##
## 7. POD (plain old documentation, CPAN style)                              ##
##                                                                           ##
###############################################################################

# ----------------------------------------------------------------------- Notes
#
# I am using a multiple pass-through approach to parsing
# the piml file.  This saves memory and makes sure the server
# will never be overloaded.
#
# This is meant to parse files meeting the piml document type.
# See piml.dtd.  PIML=Post Installation Markup Language.

use HTML::TokeParser;

my $usage=<<END;
**** ERROR ERROR ERROR ERROR ****
Usage is for piml file to come in through standard input.
1st argument is the mode of parsing.
2nd argument is the category permissions to use (runtime or development)
3rd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).
4th argument is to manually specify a sourceroot.
5th argument is to manually specify a targetroot.

Only the 1st argument is mandatory for the program to run.

Example:

cat ../../doc/loncapafiles.piml |\\
perl piml_parse.pl html development default /home/sherbert/loncapa /tmp/install
END

# ------------------------------------------------- Grab command line arguments

my $mode;
if (@ARGV==4) {
    $mode = shift @ARGV;
}
else {
    @ARGV=();shift @ARGV;
    while(<>){} # throw away the input to avoid broken pipes
    print $usage;
    exit -1; # exit with error status
}

my $categorytype;
if (@ARGV) {
    $categorytype = shift @ARGV;
}

my $dist;
if (@ARGV) {
    $dist = shift @ARGV;
}

my $targetroot;
my $sourceroot;
my $targetrootarg;
my $sourcerootarg;
if (@ARGV) {
    $targetroot = shift @ARGV;
}
$sourceroot=~s/\/$//;
$targetroot=~s/\/$//;
$sourcerootarg=$sourceroot;
$targetrootarg=$targetroot;

my $logcmd='| tee -a WARNINGS';

my $invocation;
# --------------------------------------------------- Record program invocation
if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
    $invocation=(<<END);
# Invocation: STDINPUT | piml_parse.pl
#             1st argument (mode) is: $mode
#             2nd argument (category type) is: $categorytype
#             3rd argument (distribution) is: $dist
#             4th argument (sourceroot) is: described below
#             5th argument (targetroot) is: described below
END
}

# ---------------------------------------------------- Start first pass through
my @parsecontents = <>;
my $parsestring = join('',@parsecontents);
my $outstring;

# Need to make a pass through and figure out what defaults are
# overrided.  Top-down overriding strategy (leaves don't know
# about distant leaves).

my @hierarchy;
$hierarchy[0]=0;
my $hloc=0;
my $token;
$parser = HTML::TokeParser->new(\$parsestring) or
    die('can\'t create TokeParser object');
$parser->xml_mode('1');
my %hash;
my $key;
while ($token = $parser->get_token()) {
    if ($token->[0] eq 'S') {
	$hloc++;
	$hierarchy[$hloc]++;
	$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
	my $thisdist=' '.$token->[2]{'dist'}.' ';
	if ($thisdist eq ' default ') {
	    $hash{$key}=1; # there is a default setting for this key
	}
	elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {
	    $hash{$key}=2; # disregard default setting for this key if
	                   # there is a directly requested distribution match
	}
    }
    if ($token->[0] eq 'E') {
	$hloc--;
    }
}

# --------------------------------------------------- Start second pass through
undef $hloc;
undef @hierarchy;
undef $parser;
$hierarchy[0]=0;
$parser = HTML::TokeParser->new(\$parsestring) or
    die('can\'t create TokeParser object');
$parser->xml_mode('1');
my $cleanstring;
while ($token = $parser->get_token()) {
    if ($token->[0] eq 'S') {
	$hloc++;
	$hierarchy[$hloc]++;
	$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
	my $thisdist=' '.$token->[2]{'dist'}.' ';
	# This conditional clause is set up to ignore two sets
	# of invalid conditions before accepting entry into
	# the cleanstring.
	if ($hash{$key}==2 and
	    !($thisdist eq '  ' or $thisdist =~/\s$dist\s/)) {
	    if ($token->[4]!~/\/>$/) {
		$parser->get_tag('/'.$token->[1]);
		$hloc--;
	    }
	}
	elsif ($thisdist ne '  ' and $thisdist!~/\s$dist\s/ and
	       !($thisdist eq ' default ' and $hash{$key}!=2)) {
	    if ($token->[4]!~/\/>$/) {
		$parser->get_tag('/'.$token->[1]);
		$hloc--;
	    }
	}
	else {
	    $cleanstring.=$token->[4];
	}
	if ($token->[4]=~/\/>$/) {
	    $hloc--;
	}
    }
    if ($token->[0] eq 'E') {
	$cleanstring.=$token->[2];
	$hloc--;
    }
    if ($token->[0] eq 'T') {
	$cleanstring.=$token->[1];
    }
}
$cleanstring=&trim($cleanstring);
$cleanstring=~s/\>\s*\n\s*\</\>\</g;

# ---------------------------------------------------- Start final pass through

# storage variables
my $piml;
my $categories;
my @categorynamelist;
my $category;
my $category_att_name;
my $category_att_type;
my $chown;
my $chmod;
my $abbreviation; # space-free abbreviation; esp. for image names
my $rpm;
my $rpmSummary;
my $rpmName;
my $rpmVersion;
my $rpmRelease;
my $rpmVendor;
my $rpmBuildRoot;
my $rpmCopyright;
my $rpmGroup;
my $rpmSource;
my $rpmAutoReqProv;
my $rpmdescription;
my $rpmpre;
my $directories;
my $directory;
my $targetdirs;
my $targetdir;
my $categoryname;
my $description;
my $files;
my $fileglobs;
my $links;
my $file;
my $link;
my $fileglob;
my $sourcedir;
my $targets;
my $target;
my $source;
my $note;
my $build;
my $buildlink;
my $commands;
my $command;
my $status;
my $dependencies;
my $dependency;
my @links;
my %categoryhash;
my $dpathlength;
my %fab; # file category abbreviation
my $directory_count;
my $file_count;
my $link_count;
my $fileglob_count;
my $fileglobnames_count;
my %categorycount;
# START TEMP WAY
#my %bytecount;  # TEMP WAY TO COUNT INFORMATION
#my %linecount;  # TEMP WAY TO COUNT INFORMATION
# END TEMP WAY

my @buildall;
my @buildinfo;

my @configall;

# Make new parser with distribution specific input
undef $parser;
$parser = HTML::TokeParser->new(\$cleanstring) or
    die('can\'t create TokeParser object');
$parser->xml_mode('1');

# Define handling methods for mode-dependent text rendering

$parser->{textify}={
    specialnotices => \&format_specialnotices,
    specialnotice => \&format_specialnotice,
    targetroot => \&format_targetroot,
    sourceroot => \&format_sourceroot,
    categories => \&format_categories,
    category => \&format_category,
    abbreviation => \&format_abbreviation,
    targetdir => \&format_targetdir,
    chown => \&format_chown,
    chmod => \&format_chmod,
    rpm => \&format_rpm,
    rpmSummary => \&format_rpmSummary,
    rpmName => \&format_rpmName,
    rpmVersion => \&format_rpmVersion,
    rpmRelease => \&format_rpmRelease,
    rpmVendor => \&format_rpmVendor,
    rpmBuildRoot => \&format_rpmBuildRoot,
    rpmCopyright => \&format_rpmCopyright,
    rpmGroup => \&format_rpmGroup,
    rpmSource => \&format_rpmSource,
    rpmAutoReqProv => \&format_rpmAutoReqProv,
    rpmdescription => \&format_rpmdescription,
    rpmpre => \&format_rpmpre,
    rpmRequires => \&format_rpmRequires,
    directories => \&format_directories,
    directory => \&format_directory,
    categoryname => \&format_categoryname,
    description => \&format_description,
    files => \&format_files,
    file => \&format_file,
    fileglob => \&format_fileglob,
    links => \&format_links,
    link => \&format_link,
    linkto => \&format_linkto,
    source => \&format_source,
    target => \&format_target,
    note => \&format_note,
    build => \&format_build,
    status => \&format_status,
    dependencies => \&format_dependencies,
    buildlink => \&format_buildlink,
    glob => \&format_glob,
    sourcedir => \&format_sourcedir,
    filenames => \&format_filenames,
    };

my $text;
my $token;
undef $hloc;
undef @hierarchy;
my $hloc;
my @hierarchy2;
while ($token = $parser->get_tag('piml')) {
    &format_piml(@{$token});
    $text = &trim($parser->get_text('/piml'));
    $token = $parser->get_tag('/piml');
    print $piml; 
    print "\n";
#    $text=~s/\s*\n\s*\n\s*/\n/g;
    print $text;
    print "\n";
    print &end();
}
exit;

# ---------- Functions (most all just format contents of different markup tags)

# ------------------------ Final output at end of markup parsing and formatting
sub end {
    if ($mode eq 'html') {
	# START TEMP WAY
#	my $totallinecount;
#	my $totalbytecount;
#	map {$totallinecount+=$linecount{$_};
#	     $totalbytecount+=$bytecount{$_}}
# 	  @categorynamelist;
        # END TEMP WAY
	return "<br />&nbsp;<br />".
	    "<a name='summary' /><font size='+2'>Summary of Source Repository".
	    "</font>".
	    "<br />&nbsp;<br />".
	    "<table border='1' cellpadding='5'>".
	    "<caption>Files, Directories, and Symbolic Links</caption>".
	    "<tr><td>Files (not referenced by globs)</td><td>$file_count</td>".
	    "</tr>".
	    "<tr><td>Files (referenced by globs)</td>".
	    "<td>$fileglobnames_count</td>".
	    "</tr>".
	    "<tr><td>Total Files</td>".
	    "<td>".($fileglobnames_count+$file_count)."</td>".
	    "</tr>".
	    "<tr><td>File globs</td>".
	    "<td>".$fileglob_count."</td>".
	    "</tr>".
	    "<tr><td>Directories</td>".
	    "<td>".$directory_count."</td>".
	    "</tr>".
	    "<tr><td>Symbolic links</td>".
	    "<td>".$link_count."</td>".
	    "</tr>".
	    "</table>".
	    "<table border='1' cellpadding='5'>".
	    "<caption>File Category Count</caption>".
	    "<tr><th>Icon</th><th>Name</th><th>Number of Occurrences</th>".
	    "<th>Number of Incorrect Counts</th>".
	    "</tr>".
	    join("\n",(map {"<tr><td><img src='$fab{$_}.gif' ".
		 "alt='$_ icon' /></td>".
 	         "<td>$_</td><td>$categorycount{$_}</td>".
		 "<td><!-- POSTEVALINLINE $_ --></td></tr>"}
		@categorynamelist)).
	    "</table>".
	    "</body></html>\n";

# START TEMP WAY
#	    join("\n",(map {"<tr><td><img src='$fab{$_}.gif' ".
#		 "alt='$_ icon' /></td>".
# 	         "<td>$_</td><td>$categorycount{$_}</td><td>$linecount{$_}</td><td>$bytecount{$_}</td></tr>"}
#		@categorynamelist)).
#	    "<br />&nbsp;<br />".
#	    "Total Lines of Code: $totallinecount".
#	    "<br />&nbsp;<br />".
#	    "Total Bytes: $totalbytecount".
# END TEMP WAY
    }
    if ($mode eq 'install') {
	return '';
    }
}

# ----------------------- Take in string to parse and the separation expression
sub extract_array {
    my ($stringtoparse,$sepexp) = @_;
    my @a=split(/$sepexp/,$stringtoparse);
    return \@a;
}

# --------------------------------------------------------- Format piml section
sub format_piml {
    my (@tokeninfo)=@_;
    my $date=`date`; chop $date;
    if ($mode eq 'html') {
	$piml=<<END;
<html>
<head>
<title>PIML Description Page
(dist=$dist, categorytype=$categorytype, $date)</title>
</head>
<body>
END
	$piml .= "<br /><font size='+2'>PIML Description Page (dist=$dist, ".
	    "categorytype=$categorytype, $date)".
	    "</font>";
	$piml .=<<END;
<ul>
<li><a href='#about'>About this file</a></li>
<li><a href='#ownperms'>File Type Ownership and Permissions
Descriptions</a></li>
<li><a href='#package'>Software Package Description</a></li>
<li><a href='#directories'>Directory Structure</a></li>
<li><a href='#files'>Files</a></li>
<li><a href='#summary'>Summary of Source Repository</a></li>
</ul>
END
        $piml .=<<END;
<br />&nbsp;<br /><a name='about' />
<font size='+2'>About this file</font>
<p>
This file is generated dynamically by <tt>piml_parse.pl</tt> as
part of a development compilation process.</p>
<p>PIML written by Scott Harrison (harris41\@msu.edu).
</p>
END
    }
    elsif ($mode eq 'text') {
	$piml = "PIML Description Page (dist=$dist, $date)";
	$piml .=<<END;

* About this file
* Software Package Description
* Directory Structure
* File Type Ownership and Permissions
* Files
END
        $piml .=<<END;

About this file

This file is generated dynamically by piml_parse.pl as
part of a development compilation process.  Author: Scott
Harrison (harris41\@msu.edu).

END
    }
    elsif ($mode eq 'install') {
	print '# PIML install targets. Linux Packaging Markup Language,';
	print ' by Scott Harrison 2001'."\n";
	print '# This file was automatically generated on '.`date`;
	print "\n".$invocation;
	$piml .= "SHELL=\"/bin/bash\"\n\n";
    }
    elsif ($mode eq 'configinstall') {
	print '# PIML configuration file targets (configinstall).'."\n";
	print '# Linux Packaging Markup Language,';
	print ' by Scott Harrison 2001'."\n";
	print '# This file was automatically generated on '.`date`;
	print "\n".$invocation;
	$piml .= "SHELL=\"/bin/bash\"\n\n";
    }
    elsif ($mode eq 'build') {
	$piml = "# PIML build targets. Linux Packaging Markup Language,";
	$piml .= ' by Scott Harrison 2001'."\n";
	$piml .= '# This file was automatically generated on '.`date`;
	$piml .= "\n".$invocation;
	$piml .= "SHELL=\"/bin/sh\"\n\n";
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format targetroot section
sub format_targetroot {
    my $text=&trim($parser->get_text('/targetroot'));
    $text=$targetroot if $targetroot;
    $parser->get_tag('/targetroot');
    if ($mode eq 'html') {
	return $targetroot="\n<br />TARGETROOT: $text";
    }
    elsif ($mode eq 'install' or $mode eq 'build' or
	   $mode eq 'configinstall') {
	return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format sourceroot section
sub format_sourceroot {
    my $text=&trim($parser->get_text('/sourceroot'));
    $text=$sourceroot if $sourceroot;
    $parser->get_tag('/sourceroot');
    if ($mode eq 'html') {
	return $sourceroot="\n<br />SOURCEROOT: $text";
    }
    elsif ($mode eq 'install' or $mode eq 'build' or
	   $mode eq 'configinstall') {
	return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format categories section
sub format_categories {
    my $text=&trim($parser->get_text('/categories'));
    $parser->get_tag('/categories');
    if ($mode eq 'html') {
	return $categories="\n<br />&nbsp;<br />".
	    "\n<a name='ownperms'>".
	    "\n<font size='+2'>File Type Ownership and Permissions".
	    " Descriptions</font>".
	    "\n<p>This table shows what permissions and ownership settings ".
	    "correspond to each category.</p>".
	    "\n<table border='1' cellpadding='5' width='60%'>\n".
	    "<tr>".
	    "<th align='left' bgcolor='#ffffff'>Icon</th>".
	    "<th align='left' bgcolor='#ffffff'>Category Name</th>".
	    "<th align='left' bgcolor='#ffffff'>Permissions ".
	    "($categorytype)</th>".
	    "</tr>".
	    "\n$text\n".
	    "</table>\n";
    }
    elsif ($mode eq 'text') {
	return $categories="\n".
	    "\nFile Type Ownership and Permissions".
	    " Descriptions".
	    "\n$text".
	    "\n";
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format categories section
sub format_category {
    my (@tokeninfo)=@_;
    $category_att_name=$tokeninfo[2]->{'name'};
    $category_att_type=$tokeninfo[2]->{'type'};
    $abbreviation=''; $chmod='';$chown='';
    $parser->get_text('/category');
    $parser->get_tag('/category');
    $fab{$category_att_name}=$abbreviation;
    if ($mode eq 'html') {
	if ($category_att_type eq $categorytype) {
	    push @categorynamelist,$category_att_name;
	    $categoryhash{$category_att_name}="$chmod $chown";
	    return $category="<tr>".
		"<td><img src='$abbreviation.gif' ".
   	        "alt='${category_att_name}' /></td>\n".
		"<td>${category_att_name}</td>\n".
		"<td>$chmod $chown</td>\n".
		"</tr>".
		"\n";
#	return $category="\n<br />CATEGORY $category_att_name ".
#	    "$category_att_type $chmod $chown";
	}
    }
    else {
	if ($category_att_type eq $categorytype) {
	    my ($user,$group)=split(/\:/,$chown);
	    $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
		' -m '.$chmod;
	}
	return '';
    }
}
# --------------------------------------------------- Format categories section
sub format_abbreviation {
    my @tokeninfo=@_;
    $abbreviation='';
    my $text=&trim($parser->get_text('/abbreviation'));
    if ($text) {
	$parser->get_tag('/abbreviation');
	$abbreviation=$text;
    }
    return '';
}
# -------------------------------------------------------- Format chown section
sub format_chown {
    my @tokeninfo=@_;
    $chown='';
    my $text=&trim($parser->get_text('/chown'));
    if ($text) {
	$parser->get_tag('/chown');
	$chown=$text;
    }
    return '';
}
# -------------------------------------------------------- Format chmod section
sub format_chmod {
    my @tokeninfo=@_;
    $chmod='';
    my $text=&trim($parser->get_text('/chmod'));
    if ($text) {
	$parser->get_tag('/chmod');
	$chmod=$text;
    }
    return '';
}
# ---------------------------------------------------------- Format rpm section
sub format_rpm {
    my $text=&trim($parser->get_text('/rpm'));
    $parser->get_tag('/rpm');
    if ($mode eq 'html') {
	return $rpm=<<END;
<br />&nbsp;<br />
<a name='package' />
<font size='+2'>Software Package Description</font>
<p>
<table bgcolor='#ffffff' border='0' cellpadding='10' cellspacing='0'>
<tr><td><pre>
$text
</pre></td></tr>
</table>
END
    }
    elsif ($mode eq 'make_rpm') {
	return $text;
    }
    elsif ($mode eq 'text') {
	return $rpm=<<END;
Software Package Description

$text
END
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format rpmSummary section
sub format_rpmSummary {
    my $text=&trim($parser->get_text('/rpmSummary'));
    $parser->get_tag('/rpmSummary');
    if ($mode eq 'html') {
	return $rpmSummary="\nSummary     : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmSummary="\nSummary     : $text";
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<summary>$text</summary>
END
    }
    else {
	return '';
    }
}
# ------------------------------------------------------ Format rpmName section
sub format_rpmName {
    my $text=&trim($parser->get_text('/rpmName'));
    $parser->get_tag('/rpmName');
    if ($mode eq 'html') {
	return $rpmName="\nName        : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmName="\nName        : $text";
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<name>$text</name>
END
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format rpmVersion section
sub format_rpmVersion {
    my $text=$parser->get_text('/rpmVersion');
    $parser->get_tag('/rpmVersion');
    if ($mode eq 'html') {
	return $rpmVersion="\nVersion     : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmVersion="\nVersion     : $text";
    }
    else {
	return '';
    }
}
# --------------------------------------------------- Format rpmRelease section
sub format_rpmRelease {
    my $text=$parser->get_text('/rpmRelease');
    $parser->get_tag('/rpmRelease');
    if ($mode eq 'html') {
	return $rpmRelease="\nRelease     : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmRelease="\nRelease     : $text";
    }
    else {
	return '';
    }
}
# ---------------------------------------------------- Format rpmVendor section
sub format_rpmVendor {
    my $text=$parser->get_text('/rpmVendor');
    $parser->get_tag('/rpmVendor');
    if ($mode eq 'html') {
	return $rpmVendor="\nVendor      : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmVendor="\nVendor      : $text";
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<vendor>$text</vendor>
END
    }
    else {
	return '';
    }
}
# ------------------------------------------------- Format rpmBuildRoot section
sub format_rpmBuildRoot {
    my $text=$parser->get_text('/rpmBuildRoot');
    $parser->get_tag('/rpmBuildRoot');
    if ($mode eq 'html') {
	return $rpmBuildRoot="\nBuild Root  : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmBuildRoot="\nBuild Root  : $text";
    }
    else {
	return '';
    }
}
# ------------------------------------------------- Format rpmCopyright section
sub format_rpmCopyright {
    my $text=$parser->get_text('/rpmCopyright');
    $parser->get_tag('/rpmCopyright');
    if ($mode eq 'html') {
	return $rpmCopyright="\nLicense     : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmCopyright="\nLicense     : $text";
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<copyright>$text</copyright>
END
    }
    else {
	return '';
    }
}
# ----------------------------------------------------- Format rpmGroup section
sub format_rpmGroup {
    my $text=$parser->get_text('/rpmGroup');
    $parser->get_tag('/rpmGroup');
    if ($mode eq 'html') {
	return $rpmGroup="\nGroup       : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmGroup="\nGroup       : $text";
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<group>Utilities/System</group>
END
    }
    else {
	return '';
    }
}
# ---------------------------------------------------- Format rpmSource section
sub format_rpmSource {
    my $text=$parser->get_text('/rpmSource');
    $parser->get_tag('/rpmSource');
    if ($mode eq 'html') {
	return $rpmSource="\nSource      : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmSource="\nSource      : $text";
    }
    else {
	return '';
    }
}
# ----------------------------------------------- Format rpmAutoReqProv section
sub format_rpmAutoReqProv {
    my $text=$parser->get_text('/rpmAutoReqProv');
    $parser->get_tag('/rpmAutoReqProv');
    if ($mode eq 'html') {
	return $rpmAutoReqProv="\nAutoReqProv : $text";
    }
    elsif ($mode eq 'text') {
	return $rpmAutoReqProv="\nAutoReqProv : $text";
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<AutoReqProv>$text</AutoReqProv>
END
    }
    else {
	return '';
    }
}
# ----------------------------------------------- Format rpmdescription section
sub format_rpmdescription {
    my $text=$parser->get_text('/rpmdescription');
    $parser->get_tag('/rpmdescription');
    if ($mode eq 'html') {
	$text=~s/\n//g;
	$text=~s/\\n/\n/g;
	return $rpmdescription="\nDescription : $text";
    }
    elsif ($mode eq 'text') {
	$text=~s/\n//g;
	$text=~s/\\n/\n/g;
	return $rpmdescription="\nDescription : $text";
    }
    elsif ($mode eq 'make_rpm') {
	$text=~s/\n//g;
	$text=~s/\\n/\n/g;
	return <<END;
<description>$text</description>
END
    }
    else {
	return '';
    }
}
# ------------------------------------------------------- Format rpmpre section
sub format_rpmpre {
    my $text=$parser->get_text('/rpmpre');
    $parser->get_tag('/rpmpre');
    if ($mode eq 'html') {
#	return $rpmpre="\n<br />RPMPRE $text";
	return '';
    }
    elsif ($mode eq 'make_rpm') {
	return <<END;
<pre>$text</pre>
END
    }
    else {
	return '';
    }
}
# -------------------------------------------------- Format requires section
sub format_rpmRequires {
    my @tokeninfo=@_;
    my $aref;
    my $text;
    if ($mode eq 'make_rpm') {
	while ($aref=$parser->get_token()) {
	    if ($aref->[0] eq 'E' && $aref->[1] eq 'rpmRequires') {
		last;
	    }
	    elsif ($aref->[0] eq 'S') {
		$text.=$aref->[4];
	    }
	    elsif ($aref->[0] eq 'E') {
		$text.=$aref->[2];
	    }
	    else {
		$text.=$aref->[1];
	    }
	}
    }
    else {
	$parser->get_tag('/rpmRequires');
	return '';
    }
    return '<rpmRequires>'.$text.'</rpmRequires>';
}
# -------------------------------------------------- Format directories section
sub format_directories {
    my $text=$parser->get_text('/directories');
    $parser->get_tag('/directories');
    if ($mode eq 'html') {
	$text=~s/\[\{\{\{\{\{DPATHLENGTH\}\}\}\}\}\]/$dpathlength/g;
	return $directories="\n<br />&nbsp;<br />".
	    "<a name='directories' />".
	    "<font size='+2'>Directory Structure</font>".
	    "\n<br />&nbsp;<br />".
	    "<table border='1' cellpadding='3' cellspacing='0'>\n".
	    "<tr><th bgcolor='#ffffff'>Category</th>".
	    "<th bgcolor='#ffffff'>Status</th>\n".
	    "<th bgcolor='#ffffff'>Expected Permissions & Ownership</th>\n".
	    "<th bgcolor='#ffffff' colspan='$dpathlength'>Target Directory ".
	    "Path</th></tr>\n".
 	    "\n$text\n</table><br />"."\n";
    }
    elsif ($mode eq 'text') {
	return $directories="\nDirectory Structure\n$text\n".
	    "\n";
    }
    elsif ($mode eq 'install') {
	return "\n".'directories:'."\n".$text;
    }
    elsif ($mode eq 'rpm_file_list') {
	return $text;
    }
    else {
	return '';
    }
}
# ---------------------------------------------------- Format directory section
sub format_directory {
    my (@tokeninfo)=@_;
    $targetdir='';$categoryname='';$description='';
    $parser->get_text('/directory');
    $parser->get_tag('/directory');
    $directory_count++;
    $categorycount{$categoryname}++;
    if ($mode eq 'html') {
	my @a;
	@a=($targetdir=~/\//g);
	my $d=scalar(@a)+1;
	$dpathlength=$d if $d>$dpathlength;
	my $thtml=$targetdir;
	$thtml=~s/\//\<\/td\>\<td bgcolor='#ffffff'\>/g;
	my ($chmod,$chown)=split(/\s/,$categoryhash{$categoryname});
	return $directory="\n<tr><td rowspan='2' bgcolor='#ffffff'>".
	    "$categoryname</td>".
	    "<td rowspan='2' bgcolor='#ffffff'><!-- POSTEVAL [$categoryname] verify.pl directory /$targetdir $categoryhash{$categoryname} -->&nbsp;</td>".
	    "<td rowspan='2' bgcolor='#ffffff'>$chmod<br />$chown</td>".
	    "<td bgcolor='#ffffff'>$thtml</td></tr>".
	    "<tr><td bgcolor='#ffffff' colspan='[{{{{{DPATHLENGTH}}}}}]'>".
	    "$description</td></tr>";
    }
    if ($mode eq 'text') {
	return $directory="\nDIRECTORY $targetdir $categoryname ".
	    "$description";
    }
    elsif ($mode eq 'install') {
	return "\t".'install '.$categoryhash{$categoryname}.' -d '.
	    $targetroot.'/'.$targetdir."\n";
    }
    elsif ($mode eq 'rpm_file_list') {
	return $targetroot.'/'.$targetdir."\n";
    }
    else {
	return '';
    }
}
# ---------------------------------------------------- Format targetdir section
sub format_targetdir {
    my @tokeninfo=@_;
    $targetdir='';
    my $text=&trim($parser->get_text('/targetdir'));
    if ($text) {
	$parser->get_tag('/targetdir');
	$targetdir=$text;
    }
    return '';
}
# ------------------------------------------------- Format categoryname section
sub format_categoryname {
    my @tokeninfo=@_;
    $categoryname='';
    my $text=&trim($parser->get_text('/categoryname'));
    if ($text) {
	$parser->get_tag('/categoryname');
	$categoryname=$text;
    }
    return '';
}
# -------------------------------------------------- Format description section
sub format_description {
    my @tokeninfo=@_;
    $description='';
    my $text=&htmlsafe(&trim($parser->get_text('/description')));
    if ($text) {
	$parser->get_tag('/description');
	$description=$text;
    }
    return '';
}
# -------------------------------------------------------- Format files section
sub format_files {
    my $text=$parser->get_text('/files');
    $parser->get_tag('/files');
    if (1==1) {
	return '# Files'."\n".$text;
    }
    elsif ($mode eq 'html') {
	return $directories="\n<br />&nbsp;<br />".
	    "<a name='files' />".
	    "<font size='+2'>Files</font><br />&nbsp;<br />".
	    "<p>All source and target locations are relative to the ".
	    "sourceroot and targetroot values at the beginning of this ".
	    "document.</p>".
	    "\n<table border='1' cellpadding='5'>".
	    "<tr><th>Status</th><th colspan='2'>Category</th>".
	    "<th>Name/Location</th>".
	    "<th>Description</th><th>Notes</th></tr>".
	    "$text</table>\n".
	    "\n";
    }
    elsif ($mode eq 'text') {
	return $directories="\n".
	    "File and Directory Structure".
	    "\n$text\n".
	    "\n";
    }
    elsif ($mode eq 'install') {
	return "\n".'files:'."\n".$text.
	    "\n".'links:'."\n".join('',@links);
    }
    elsif ($mode eq 'configinstall') {
	return "\n".'configfiles: '.
	join(' ',@configall).
	"\n\n".$text.
	"\n\nalwaysrun:\n\n";
    }
    elsif ($mode eq 'build') {
	my $binfo;
	my $tword;
	my $command2;
	my @deps;
	foreach my $bi (@buildinfo) {
	    my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi);
	    $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; 
	    if ($command!~/\s/) {
		$command=~s/\/([^\/]*)$//;
		$command2="cd $command; sh ./$1;\\";
	    }
	    else {
		$command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
		$command2="cd $command; sh ./$2;\\";
	    }
	    my $depstring;
	    my $depstring2="\t\t\@echo '';\\\n";
	    my $olddep;
	    foreach my $dep (@deps) {
		unless ($olddep) {
		    $olddep=$deps[$#deps];
		}
		$depstring.="\telif !(test -r $command/$dep);\\\n";
		$depstring.="\t\tthen echo ".
		"\"**** WARNING **** missing the file: ".
 	        "$command/$dep\"$logcmd;\\\n";
		$depstring.="\t\ttest -e $source || test -e $target || echo ".
		    "'**** ERROR **** neither source=$source nor target=".
		    "$target exist and they cannot be built'$logcmd;\\\n";
		$depstring.="\t\tmake -f Makefile.build ${source}___DEPS;\\\n";
		if ($olddep) {
		    $depstring2.="\t\tECODE=0;\\\n";
		    $depstring2.="\t\t! test -e $source && test -r $command/$olddep &&".
			" { perl filecompare.pl -b2 $command/$olddep $target ||  ECODE=\$\$?; } && { [ \$\$ECODE != \"2\" ] || echo \"**** WARNING **** dependency $command/$olddep is newer than target file $target; SOMETHING MAY BE WRONG\"$logcmd; };\\\n";
		}
		$olddep=$dep;
	    }
	    $binfo.="$source: $tword\n".
		"\t\@if !(echo \"\");\\\n\t\tthen echo ".
		"\"**** WARNING **** Strange shell. ".
 	        "Check your path settings.\"$logcmd;\\\n".
		$depstring.
		"\telse \\\n\t\t$command2\n\tfi\n\n";
	    $binfo.="${source}___DEPS:\n".$depstring2."\t\tECODE=0;\n\n";
	}
	return 'all: '.join(' ',@buildall)."\n\n".
  	        $text.
		$binfo."\n".
		"alwaysrun:\n\n";
    }
    elsif ($mode eq 'rpm_file_list') {
	return $text;
    }
    else {
	return '';
    }
}
# ---------------------------------------------------- Format fileglobs section
sub format_fileglobs {

}
# -------------------------------------------------------- Format links section
# deprecated.. currently <link></link>'s are included in <files></files>
sub format_links {
    my $text=$parser->get_text('/links');
    $parser->get_tag('/links');
    if ($mode eq 'html') {
	return $links="\n<br />BEGIN LINKS\n$text\n<br />END LINKS\n";
    }
    elsif ($mode eq 'install') {
	return "\n".'links:'."\n\t".$text;
    }
    else {
	return '';
    }
}
# --------------------------------------------------------- Format file section
sub format_file {
    my @tokeninfo=@_;
    $file=''; $source=''; $target=''; $categoryname=''; $description='';
    $note=''; $build=''; $status=''; $dependencies='';
    my $text=&trim($parser->get_text('/file'));
    my $buildtest;
    $file_count++;
    $categorycount{$categoryname}++;
    # START TEMP WAY
#    if (-T "$sourcerootarg/$source") {
#	$linecount{$categoryname}+=`wc -l $sourcerootarg/$source`;
#    }
#    my $bytesize=(-s "$sourcerootarg/$source");
#    $bytecount{$categoryname}+=$bytesize;
    # END TEMP WAY
#    if ($source) {
	$parser->get_tag('/file');
            if (1==1) {
		return "File: $target\n".
		    "$dependencies\n";
	    }
            elsif ($mode eq 'html') {
	    return ($file="\n<!-- FILESORT:$target -->".
		    "<tr>".
		    "<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".
		    "'$targetrootarg' ".
		    "'$source' '$target' ".
		    "$categoryhash{$categoryname} -->&nbsp;</td><td>".
		    "<img src='$fab{$categoryname}.gif' ".
		    "alt='$categoryname icon' /></td>".
		    "<td>$categoryname<br /><font size='-1'>".
		    $categoryhash{$categoryname}."</font></td>".
		    "<td>SOURCE: $source<br />TARGET: $target</td>".
		    "<td>$description</td>".
		    "<td>$note</td>".
		    "</tr>");
#	    return ($file="\n<br />BEGIN FILE\n".
#		"$source $target $categoryname $description $note " .
#		"$build $status $dependencies" .
#		"\nEND FILE");
	}
	elsif ($mode eq 'install' && $categoryname ne 'conf') {
	    if ($build) {
		my $bi=$sourceroot.'/'.$source.';'.$build.';'.
		    $dependencies;
		my ($source2,$command,$trigger,@deps)=split(/\;/,$bi);
		$tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; 
		$command=~s/\/([^\/]*)$//;
		$command2="cd $command; sh ./$1;\\";
		my $depstring;
		foreach my $dep (@deps) {
		    $depstring.=<<END;
		ECODE=0; DEP=''; \\
		test -e $dep || (echo '**** WARNING **** cannot evaluate status of dependency $dep (for building ${sourceroot}/${source} with)'$logcmd); DEP="1"; \\
		[ -n DEP ] && { perl filecompare.pl -b2 $dep ${targetroot}/${target} || ECODE=\$\$?; } || DEP="1"; \\
		case "\$\$ECODE" in \\
			2) echo "**** WARNING **** dependency $dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\
		esac; \\
END
		}
                chomp $depstring;
		$buildtest=<<END;
	\@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\
		echo "**** ERROR **** ${sourceroot}/${source} is missing and is also not present at target location ${targetroot}/${target}; you must run make build"$logcmd; exit; \\
END
                $buildtest.=<<END if $depstring;
	elif !(test -e "${sourceroot}/${source}"); then \\
$depstring
END
                $buildtest.=<<END;
	fi
END
	    }
            my $bflag='-b1';
            $bflag='-b3' if $dependencies or $buildlink;
	    return <<END;
$buildtest	\@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\
		echo "**** ERROR **** CVS source file does not exist: ${sourceroot}/${source} and neither does target: ${targetroot}/${target}"$logcmd; \\
	elif !(test -e "${sourceroot}/${source}"); then \\
		echo "**** WARNING **** CVS source file does not exist: ${sourceroot}/${source}"$logcmd; \\
		perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
	else \\
		ECODE=0; \\
		perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${target} || ECODE=\$\$?; \\
		case "\$\$ECODE" in \\
			1) echo "${targetroot}/${target} is unchanged";; \\
			2) echo "**** WARNING **** target file ${targetroot}/${target} is newer than CVS source; saving current (old) target file to ${targetroot}/${target}.pimlsave and then overwriting"$logcmd && install -o www -g www -m 0600 ${targetroot}/${target} ${targetroot}/${target}.pimlsave && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
			0) echo "install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
		esac; \\
		perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
	fi
END
	}
	elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
	    push @configall,$targetroot.'/'.$target;
	    return $targetroot.'/'.$target.': alwaysrun'."\n".
		"\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 '.
		$sourceroot.'/'.$source.' '.$targetroot.'/'.$target.
		' || ECODE=$$?; } && '.
		'{ [ $$ECODE != "2" ] || (install '.
                $categoryhash{$categoryname}.' '.
		$sourceroot.'/'.$source.' '.
		$targetroot.'/'.$target.'.pimlnew'.
		' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'.
		$logcmd.' && echo "'.
		'You likely need to compare contents of '.
		''.$targetroot.'/'.$target.' with the new '.
                ''.$targetroot.'/'.$target.'.pimlnew"'.
		"$logcmd); } && ".
		'{ [ $$ECODE != "3" ] || (install '.
                $categoryhash{$categoryname}.' '.
		$sourceroot.'/'.$source.' '.
		$targetroot.'/'.$target.''.
		' && echo "**** WARNING: NEW CONFIGURATION FILE ADDED ****"'.
		$logcmd.' && echo "'.
		'You likely need to review the contents of '.
		''.$targetroot.'/'.$target.' to make sure its '.
                'settings are compatible with your overall system"'.
		"$logcmd); } && ".
		'{ [ $$ECODE != "1" ] || ('.
		'echo "**** ERROR ****"'.
		$logcmd.' && echo "'.
		'Configuration source file does not exist '.
		''.$sourceroot.'/'.$source.'"'.
		"$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"$categoryhash{$categoryname}\"$logcmd;\n\n";
	}
	elsif ($mode eq 'build' && $build) {
	    push @buildall,$sourceroot.'/'.$source;
	    push @buildinfo,$targetroot.'/'.$target.';'.$sourceroot.'/'.
		$source.';'.$build.';'.
		$dependencies;
#	    return '# need to build '.$source.";
	}
        elsif ($mode eq 'rpm_file_list') {
	    if ($categoryname eq 'doc') {
		return $targetroot.'/'.$target.' # doc'."\n";
	    }
	    elsif ($categoryname eq 'conf') {
		return $targetroot.'/'.$target.' # config'."\n";
	    }
	    else {
		return $targetroot.'/'.$target."\n";
	    }
	}
	else {
	    return '';
	}
#    }
    return '';
}
# --------------------------------------------------------- Format link section
sub format_link {
    my @tokeninfo=@_;
    $link=''; $linkto=''; $source=''; $target=''; $categoryname=''; 
    $description=''; $note=''; $build=''; $status=''; $dependencies='';
    my $text=&trim($parser->get_text('/link'));
    if ($linkto) {
	$parser->get_tag('/link');
	if ($mode eq 'html') {
	    my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
	    $link_count+=scalar(@targets);
	    foreach my $tgt (@targets) {
		$categorycount{$categoryname}++;
		push @links,("\n<!-- FILESORT:$tgt -->".
		    "<tr>".
		    "<td><!-- POSTEVAL [$categoryname] verify.pl link ".
		    "'/$targetrootarg$linkto' '/$targetrootarg$tgt' ".
		    "$categoryhash{$categoryname} -->&nbsp;</td><td>".
		    "<img src='$fab{$categoryname}.gif' ".
		    "alt='$categoryname icon' /></td>".
		    "<td><font size='-1'>$categoryname</font></td>".
		    "<td>LINKTO: $linkto<br />TARGET: $tgt</td>".
		    "<td>$description</td>".
		    "<td>$note</td>".
		    "</tr>");
#		push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt.
#		    "\n";
	    }
	    return join('',@links);
#	    return ($link="\n<!-- FILESORT:$target -->".
#		    "<tr>".
#		    "<td>&nbsp;</td><td><img src='$fab{$categoryname}.gif' ".
#		    "alt='$categoryname icon' /></td>".
#		    "<td>$categoryname</td>".
#		    "<td>LINKTO: $linkto<br />TARGET: $target</td>".
#		    "<td>$description</td>".
#		    "<td>$note</td>".
#		    "</tr>");
#	    return $link="\n<tr><td colspan='6'>BEGIN LINK\n".
#		"$linkto $target $categoryname $description $note " .
#		"$build $status $dependencies" .
#		    "\nEND LINK</td></tr>";
	}
	elsif ($mode eq 'install') {
	    my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
	    foreach my $tgt (@targets) {
		push @links,"\t".'ln -fs /'.$linkto.' '.$targetroot.'/'.$tgt.
		    "\n";
	    }
#	    return join('',@links);
	    return '';
	}
	elsif ($mode eq 'rpm_file_list') {
	    my @linklocs;
	    my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
	    foreach my $tgt (@targets) {
		push @linklocs,''.$targetroot.'/'.$tgt."\n";
	    }
	    return join('',@linklocs);
	}
	else {
	    return '';
	}
    }
    return '';
}
# ----------------------------------------------------- Format fileglob section
sub format_fileglob {
    my @tokeninfo=@_;
    $fileglob=''; $glob=''; $sourcedir='';
    $targetdir=''; $categoryname=''; $description='';
    $note=''; $build=''; $status=''; $dependencies='';
    $filenames='';
    my $text=&trim($parser->get_text('/fileglob'));
    my $filenames2=$filenames;$filenames2=~s/\s//g;
    $fileglob_count++;
    my @semi=($filenames2=~/(\;)/g);
    $fileglobnames_count+=scalar(@semi)+1;
    $categorycount{$categoryname}+=scalar(@semi)+1;
    # START TEMP WAY
#    for my $f (split(/\;/,$filenames2)) {
#	if (-T "$sourcerootarg/$sourcedir/$f") {
#	    $linecount{$categoryname}+=`wc -l $sourcerootarg/$sourcedir/$f`;
#	    open OUT,">>/tmp/junk123";
#	    print OUT "$linecount{$categoryname} $categoryname $sourcerootarg/$sourcedir/$f\n";
#	    close OUT;
#	}
#	my $bytesize=(-s "$sourcerootarg/$sourcedir/$f");
#	$bytecount{$categoryname}+=$bytesize;
#    }
    # END TEMP WAY
    if ($sourcedir) {
	$parser->get_tag('/fileglob');
	if ($mode eq 'html') {
	    return $fileglob="\n<tr>".
		"<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
		"'$targetrootarg' ".
		"'$glob' '$sourcedir' '$filenames2' '$targetdir' ".
		"$categoryhash{$categoryname} -->&nbsp;</td>".
		"<td>"."<img src='$fab{$categoryname}.gif' ".
	        "alt='$categoryname icon' /></td>".
		"<td>$categoryname<br />".
		"<font size='-1'>".$categoryhash{$categoryname}."</font></td>".
		"<td>SOURCEDIR: $sourcedir<br />".
		"TARGETDIR: $targetdir<br />".
                "GLOB: $glob<br />".
                "FILENAMES: $filenames".
		"</td>".
		"<td>$description</td>".
		"<td>$note</td>".
		"</tr>";
#	    return $fileglob="\n<tr><td colspan='6'>BEGIN FILEGLOB\n".
#		"$glob sourcedir $targetdir $categoryname $description $note ".
#		"$build $status $dependencies $filenames" .
#		"\nEND FILEGLOB</td></tr>";
	}
	elsif ($mode eq 'install') {
	    my $eglob=$glob;
	    if ($glob eq '*') {
		$eglob='[^C][^V][^S]'.$glob;
	    }
	    return "\t".'install '.
		$categoryhash{$categoryname}.' '.
		$sourceroot.'/'.$sourcedir.$eglob.' '.
		$targetroot.'/'.$targetdir.'.'."\n";
	}
	elsif ($mode eq 'rpm_file_list') {
	    my $eglob=$glob;
	    if ($glob eq '*') {
		$eglob='[^C][^V][^S]'.$glob;
	    }
	    my $targetdir2=$targetdir;$targetdir2=~s/\/$//;
	    my @gfiles=map {s/^.*\///;"$targetroot/$targetdir2/$_\n"}
	               glob("$sourceroot/$sourcedir/$eglob");
	    return join('',@gfiles);
	}
	else {
	    return '';
	}
    }
    return '';
}
# ---------------------------------------------------- Format sourcedir section
sub format_sourcedir {
    my @tokeninfo=@_;
    $sourcedir='';
    my $text=&trim($parser->get_text('/sourcedir'));
    if ($text) {
	$parser->get_tag('/sourcedir');
	$sourcedir=$text;
    }
    return '';
}
# ------------------------------------------------------- Format target section
sub format_target {
    my @tokeninfo=@_;
    $target='';
    my $text=&trim($parser->get_text('/target'));
    if ($text) {
	$parser->get_tag('/target');
	$target=$text;
    }
    return '';
}
# ------------------------------------------------------- Format source section
sub format_source {
    my @tokeninfo=@_;
    $source='';
    my $text=&trim($parser->get_text('/source'));
    if ($text) {
	$parser->get_tag('/source');
	$source=$text;
    }
    return '';
}
# --------------------------------------------------------- Format note section
sub format_note {
    my @tokeninfo=@_;
    $note='';
#    my $text=&trim($parser->get_text('/note'));
    my $aref;
    my $text;
    while ($aref=$parser->get_token()) {
	if ($aref->[0] eq 'E' && $aref->[1] eq 'note') {
	    last;
	}
	elsif ($aref->[0] eq 'S') {
	    $text.=$aref->[4];
	}
	elsif ($aref->[0] eq 'E') {
	    $text.=$aref->[2];
	}
	else {
	    $text.=$aref->[1];
	}
    }
    if ($text) {
#	$parser->get_tag('/note');
	$note=$text;
    }
    return '';

}
# -------------------------------------------------------- Format build section
sub format_build {
    my @tokeninfo=@_;
    $build='';
    my $text=&trim($parser->get_text('/build'));
    if ($text) {
	$parser->get_tag('/build');
	$build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
    }
    return '';
}
# -------------------------------------------------------- Format build section
sub format_buildlink {
    my @tokeninfo=@_;
    $buildlink='';
    my $text=&trim($parser->get_text('/buildlink'));
    if ($text) {
	$parser->get_tag('/buildlink');
	$buildlink=$sourceroot.'/'.$text;
    }
    return '';
}
# ------------------------------------------------------- Format status section
sub format_status {
    my @tokeninfo=@_;
    $status='';
    my $text=&trim($parser->get_text('/status'));
    if ($text) {
	$parser->get_tag('/status');
	$status=$text;
    }
    return '';
}
# ------------------------------------------------- Format dependencies section
sub format_dependencies {
    my @tokeninfo=@_;
    $dependencies='';
    my $text=&trim($parser->get_text('/dependencies'));
    if ($text) {
	$parser->get_tag('/dependencies');
	$dependencies=join(';',
			      (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
    }
    return '';
}
# --------------------------------------------------------- Format glob section
sub format_glob {
    my @tokeninfo=@_;
    $glob='';
    my $text=&trim($parser->get_text('/glob'));
    if ($text) {
	$parser->get_tag('/glob');
	$glob=$text;
    }
    return '';
}
# ---------------------------------------------------- Format filenames section
sub format_filenames {
    my @tokeninfo=@_;
    my $text=&trim($parser->get_text('/filenames'));
    if ($text) {
	$parser->get_tag('/filenames');
	$filenames=$text;
    }
    return '';
}
# ------------------------------------------------ Format specialnotice section
sub format_specialnotices {
    $parser->get_tag('/specialnotices');
    return '';
}
# ------------------------------------------------ Format specialnotice section
sub format_specialnotice {
    $parser->get_tag('/specialnotice');
    return '';
}
# ------------------------------------------------------- Format linkto section
sub format_linkto {
    my @tokeninfo=@_;
    my $text=&trim($parser->get_text('/linkto'));
    if ($text) {
	$parser->get_tag('/linkto');
	$linkto=$text;
    }
    return '';
}
# ------------------------------------- Render less-than and greater-than signs
sub htmlsafe {
    my $text=@_[0];
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    return $text;
}
# --------------------------------------- remove starting and ending whitespace
sub trim {
    my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
} 

# ----------------------------------- POD (plain old documentation, CPAN style)

=head1 NAME

piml_parse.pl - This is meant to parse files meeting the piml document type.
See piml.dtd.  PIML=Linux Packaging Markup Language.

=head1 SYNOPSIS

Usage is for piml file to come in through standard input.

=over 4

=item *

1st argument is the mode of parsing.

=item * 

2nd argument is the category permissions to use (runtime or development)

=item *

3rd argument is the distribution
(default,redhat6.2,debian2.2,redhat7.1,etc).

=item *

4th argument is to manually specify a sourceroot.

=item *

5th argument is to manually specify a targetroot.

=back

Only the 1st argument is mandatory for the program to run.

Example:

cat ../../doc/loncapafiles.piml |\\
perl piml_parse.pl html default /home/sherbert/loncapa /tmp/install

=head1 DESCRIPTION

I am using a multiple pass-through approach to parsing
the piml file.  This saves memory and makes sure the server
will never be overloaded.

=head1 README

I am using a multiple pass-through approach to parsing
the piml file.  This saves memory and makes sure the server
will never be overloaded.

=head1 PREREQUISITES

HTML::TokeParser

=head1 COREQUISITES

=head1 OSNAMES

linux

=head1 SCRIPT CATEGORIES

Packaging/Administrative

=cut