[BACK]Return to lpml_parse.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/lpml_parse.pl between versions 1.19 and 1.51

version 1.19, 2001/11/17 18:35:21 version 1.51, 2002/10/13 17:27:49
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
 # Scott Harrison  # -------------------------------------------------------- Documentation notice
   # Run "perldoc ./lpml_parse.pl" in order to best view the software
   # documentation internalized in this program.
   
   # --------------------------------------------------------- Distribution notice
   # This script is distributed with the LPML software project available at
   # http://lpml.sourceforge.net
   
   # --------------------------------------------------------- License Information
   # The LearningOnline Network with CAPA
   # lpml_parse.pl - Linux Packaging Markup Language parser
   #
   # $Id$
   #
   # Written by Scott Harrison, codeharrison@yahoo.com
   #
   # 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=2001  # YEAR=2001
 # May 2001  # May 2001
 # 06/19/2001,06/20,06/24 - Scott Harrison  # 06/19/2001,06/20,06/24 - Scott Harrison
 # 9/5/2001,9/6,9/7,9/8 - Scott Harrison  # 9/5/2001,9/6,9/7,9/8 - Scott Harrison
 # 9/17,9/18 - Scott Harrison  # 9/17,9/18 - Scott Harrison
 # 11/4,11/5,11/6,11/7,11/16 - Scott Harrison  # 11/4,11/5,11/6,11/7,11/16,11/17 - Scott Harrison
   # 12/2,12/3,12/4,12/5,12/6,12/13,12/19,12/29 - Scott Harrison
   # YEAR=2002
   # 1/8,1/9,1/29,1/31,2/5,3/21,4/8,4/12 - Scott Harrison
   # 4/21,4/26,5/19,5/23,10/13 - Scott Harrison
 #  #
 # $Id$  
 ###  ###
   
 ###############################################################################  ###############################################################################
Line 38  use HTML::TokeParser; Line 78  use HTML::TokeParser;
 my $usage=<<END;  my $usage=<<END;
 **** ERROR ERROR ERROR ERROR ****  **** ERROR ERROR ERROR ERROR ****
 Usage is for lpml file to come in through standard input.  Usage is for lpml file to come in through standard input.
 1st argument is the mode of parsing.  1st argument is the mode of parsing:
 2nd argument is the category permissions to use (runtime or development)      install,configinstall,build,rpm,dpkg,htmldoc,textdoc,status
 3rd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).  2nd argument is the category permissions to use:
       typical choices: runtime,development
   3rd argument is the distribution:
       typical choices: default,redhat6.2,debian2.2,redhat7
 4th argument is to manually specify a sourceroot.  4th argument is to manually specify a sourceroot.
 5th argument is to manually specify a targetroot.  5th argument is to manually specify a targetroot.
   
Line 49  Only the 1st argument is mandatory for t Line 92  Only the 1st argument is mandatory for t
 Example:  Example:
   
 cat ../../doc/loncapafiles.lpml |\\  cat ../../doc/loncapafiles.lpml |\\
 perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install  perl lpml_parse.pl html development default /home/sherbert/loncapa /tmp/install
   
   For more information, type "perldoc lpml_parse.pl".
 END  END
   
 # ------------------------------------------------- Grab command line arguments  # ------------------------------------------------- Grab command line arguments
   
 my $mode;  my $mode='';
 if (@ARGV==5) {  if (@ARGV==5) {
     $mode = shift @ARGV;      $mode = shift @ARGV;
 }  }
Line 65  else { Line 110  else {
     exit -1; # exit with error status      exit -1; # exit with error status
 }  }
   
 my $categorytype;  my $categorytype='';
 if (@ARGV) {  if (@ARGV) {
     $categorytype = shift @ARGV;      $categorytype = shift @ARGV;
 }  }
   
 my $dist;  my $dist='';
 if (@ARGV) {  if (@ARGV) {
     $dist = shift @ARGV;      $dist = shift @ARGV;
 }  }
   
 my $targetroot;  my $targetroot='';
 my $sourceroot;  my $sourceroot='';
   my $targetrootarg='';
   my $sourcerootarg='';
 if (@ARGV) {  if (@ARGV) {
     $sourceroot = shift @ARGV;      $sourceroot = shift @ARGV;
 }  }
 if (@ARGV) {  if (@ARGV) {
     $targetroot = shift @ARGV;      $targetroot = shift @ARGV;
 }  }
 $sourceroot=~s/\/$//;  $sourceroot=~s/\/$//; # remove trailing directory slash
 $targetroot=~s/\/$//;  $targetroot=~s/\/$//; # remove trailing directory slash
   $sourcerootarg=$sourceroot;
   $targetrootarg=$targetroot;
   
 my $logcmd='| tee -a WARNINGS';  my $logcmd='| tee -a WARNINGS';
   
 my $invocation;  my $invocation; # Record how the program was invoked
 # --------------------------------------------------- Record program invocation  # --------------------------------------------------- Record program invocation
 if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {  if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
     $invocation=(<<END);      $invocation=(<<END);
Line 96  if ($mode eq 'install' or $mode eq 'conf Line 145  if ($mode eq 'install' or $mode eq 'conf
 #             1st argument (mode) is: $mode  #             1st argument (mode) is: $mode
 #             2nd argument (category type) is: $categorytype  #             2nd argument (category type) is: $categorytype
 #             3rd argument (distribution) is: $dist  #             3rd argument (distribution) is: $dist
 #             4th argument (targetroot) is: described below  #             4th argument (sourceroot) is: described below
 #             5th argument (sourceroot) is: described below  #             5th argument (targetroot) is: described below
 END  END
 }  }
   
 # ---------------------------------------------------- Start first pass through  # -------------------------- Start first pass through (just gather information)
 my @parsecontents = <>;  my @parsecontents=<>;
 my $parsestring = join('',@parsecontents);  my $parsestring=join('',@parsecontents);
 my $outstring;  
   
 # Need to make a pass through and figure out what defaults are  # Need to make a pass through and figure out what defaults are
 # overrided.  Top-down overriding strategy (leaves don't know  # overrided.  Top-down overriding strategy (tree leaves don't know
 # about distant leaves).  # about distant tree leaves).
   
 my @hierarchy;  my @hierarchy;
 $hierarchy[0]=0;  $hierarchy[0]=0;
Line 117  my $token; Line 165  my $token;
 $parser = HTML::TokeParser->new(\$parsestring) or  $parser = HTML::TokeParser->new(\$parsestring) or
     die('can\'t create TokeParser object');      die('can\'t create TokeParser object');
 $parser->xml_mode('1');  $parser->xml_mode('1');
 my %hash;  my %setting;
 my $key;  
 while ($token = $parser->get_token()) {  # Values for the %setting hash
   my $defaultset=1; # a default setting exists for a key
   my $distset=2; # a distribution setting exists for a key
                  # (overrides default setting)
   
   my $key=''; # this is a unique key identifier (the token name with its
               # coordinates inside the hierarchy)
   while ($token = $parser->get_token()) { # navigate through $parsestring
     if ($token->[0] eq 'S') {      if ($token->[0] eq 'S') {
  $hloc++;   $hloc++;
  $hierarchy[$hloc]++;   $hierarchy[$hloc]++;
  $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);   $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
  my $thisdist=' '.$token->[2]{'dist'}.' ';   my $thisdist=' '.$token->[2]{'dist'}.' ';
  if ($thisdist eq ' default ') {   if ($thisdist eq ' default ') {
     $hash{$key}=1; # there is a default setting for this key      $setting{$key}=$defaultset;
  }   }
  elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {   elsif (length($dist)>0 &&
     $hash{$key}=2; # disregard default setting for this key if         $setting{$key}==$defaultset &&
                    # there is a directly requested distribution match         $thisdist=~/\s$dist\s/) {
       $setting{$key}=$distset;
                      # disregard default setting for this key if
                      # there is a directly requested distribution match
                      # (in other words, there must first be a default
              # setting for a key in order for it to be overridden)
  }   }
     }      }
     if ($token->[0] eq 'E') {      if ($token->[0] eq 'E') {
Line 138  while ($token = $parser->get_token()) { Line 198  while ($token = $parser->get_token()) {
     }      }
 }  }
   
 # --------------------------------------------------- Start second pass through  # - Start second pass through (clean up the string to allow for easy rendering)
 undef $hloc;  
 undef @hierarchy;  # The string is cleaned up so that there is no white-space surrounding any
 undef $parser;  # XML tag.  White-space inside text 'T' elements is preserved.
 $hierarchy[0]=0;  
   # Clear up memory
   undef($hloc);
   undef(@hierarchy);
   undef($parser);
   $hierarchy[0]=0; # initialize hierarchy
 $parser = HTML::TokeParser->new(\$parsestring) or  $parser = HTML::TokeParser->new(\$parsestring) or
     die('can\'t create TokeParser object');      die('can\'t create TokeParser object');
 $parser->xml_mode('1');  $parser->xml_mode('1');
 my $cleanstring;  my $cleanstring; # contains the output of the second step
 while ($token = $parser->get_token()) {  while ($token = $parser->get_token()) { # navigate through $parsestring
     if ($token->[0] eq 'S') {      if ($token->[0] eq 'S') { # a start tag
  $hloc++;   $hloc++;
  $hierarchy[$hloc]++;   $hierarchy[$hloc]++;
  $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);   $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
  my $thisdist=' '.$token->[2]{'dist'}.' ';  
    # Surround tagdist (the dist attribute of an XML tag)
    # with white-space to allow for uniform searching a few
    # lines below here.
    my $tagdist=' '.$token->[2]{'dist'}.' ';
   
  # This conditional clause is set up to ignore two sets   # This conditional clause is set up to ignore two sets
  # of invalid conditions before accepting entry into   # of invalid conditions before accepting entry into
  # the cleanstring.   # $cleanstring.
  if ($hash{$key}==2 and  
     !($thisdist eq '  ' or $thisdist =~/\s$dist\s/)) {   # Condition #1: Ignore this part of the string if the tag 
    # has a superior distribution-specific setting and the tag
    # being evaluated has a dist setting something other than
    # blank or $dist.
    if ($setting{$key}==$distset and
       !($tagdist eq '  ' or $tagdist =~/\s$dist\s/)) {
     if ($token->[4]!~/\/>$/) {      if ($token->[4]!~/\/>$/) {
  $parser->get_tag('/'.$token->[1]);   $parser->get_tag('/'.$token->[1]);
  $hloc--;   $hloc--;
     }      }
  }   }
  elsif ($thisdist ne '  ' and $thisdist!~/\s$dist\s/ and   # Condition #2: Ignore this part of the string if the tag has
        !($thisdist eq ' default ' and $hash{$key}!=2)) {   # is not blank and does not equal dist and
    # either does not equal default or it has a prior $dist-specific
    # setting.
    elsif ($tagdist ne '  ' and $tagdist!~/\s$dist\s/ and
          !($tagdist eq ' default ' and $setting{$key}!=$distset)) {
     if ($token->[4]!~/\/>$/) {      if ($token->[4]!~/\/>$/) {
  $parser->get_tag('/'.$token->[1]);   $parser->get_tag('/'.$token->[1]);
  $hloc--;   $hloc--;
     }      }
  }   }
    # In other words, output to $cleanstring if the tag is dist=default
    # or if the tag is set to dist=$dist for the first time.  And, always
    # output when dist='' is not present.
  else {   else {
     $cleanstring.=$token->[4];      $cleanstring.=$token->[4];
  }   }
  if ($token->[4]=~/\/>$/) {  
     $hloc--;  
  }  
     }      }
     if ($token->[0] eq 'E') {      # Note: this loop DOES work with <tag /> style markup as well as
       # <tag></tag> style markup since I always check for $token->[4] ending
       # with "/>".
       if ($token->[0] eq 'E') { # an end tag
  $cleanstring.=$token->[2];   $cleanstring.=$token->[2];
  $hloc--;   $hloc--;
     }      }
     if ($token->[0] eq 'T') {      if ($token->[0] eq 'T') { # text contents inside tags
  $cleanstring.=$token->[1];   $cleanstring.=$token->[1];
     }      }
 }  }
 $cleanstring=&trim($cleanstring);  $cleanstring=&trim($cleanstring);
 $cleanstring=~s/\>\s*\n\s*\</\>\</g;  $cleanstring=~s/\>\s*\n\s*\</\>\</g;
   
 # ---------------------------------------------------- Start final pass through  # -------------------------------------------- Start final (third) pass through
   
 # storage variables  # storage variables
 my $lpml;  my $lpml;
 my $categories;  my $categories;
   my @categorynamelist;
 my $category;  my $category;
 my $category_att_name;  my $category_att_name;
 my $category_att_type;  my $category_att_type;
 my $chown;  my $chown;
 my $chmod;  my $chmod;
   my $abbreviation; # space-free abbreviation; esp. for image names
 my $rpm;  my $rpm;
 my $rpmSummary;  my $rpmSummary;
 my $rpmName;  my $rpmName;
Line 215  my $directories; Line 299  my $directories;
 my $directory;  my $directory;
 my $targetdirs;  my $targetdirs;
 my $targetdir;  my $targetdir;
   my $protectionlevel;
 my $categoryname;  my $categoryname;
 my $description;  my $description;
 my $files;  my $files;
Line 237  my $dependencies; Line 322  my $dependencies;
 my $dependency;  my $dependency;
 my @links;  my @links;
 my %categoryhash;  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;
   
 my @buildall;  my @buildall;
 my @buildinfo;  my @buildinfo;
Line 250  $parser = HTML::TokeParser->new(\$cleans Line 343  $parser = HTML::TokeParser->new(\$cleans
 $parser->xml_mode('1');  $parser->xml_mode('1');
   
 # Define handling methods for mode-dependent text rendering  # Define handling methods for mode-dependent text rendering
   
 $parser->{textify}={  $parser->{textify}={
       specialnotices => \&format_specialnotices,
       specialnotice => \&format_specialnotice,
     targetroot => \&format_targetroot,      targetroot => \&format_targetroot,
     sourceroot => \&format_sourceroot,      sourceroot => \&format_sourceroot,
     categories => \&format_categories,      categories => \&format_categories,
     category => \&format_category,      category => \&format_category,
       abbreviation => \&format_abbreviation,
     targetdir => \&format_targetdir,      targetdir => \&format_targetdir,
       protectionlevel => \&format_protectionlevel,
     chown => \&format_chown,      chown => \&format_chown,
     chmod => \&format_chmod,      chmod => \&format_chmod,
     rpm => \&format_rpm,      rpm => \&format_rpm,
Line 271  $parser->{textify}={ Line 369  $parser->{textify}={
     rpmAutoReqProv => \&format_rpmAutoReqProv,      rpmAutoReqProv => \&format_rpmAutoReqProv,
     rpmdescription => \&format_rpmdescription,      rpmdescription => \&format_rpmdescription,
     rpmpre => \&format_rpmpre,      rpmpre => \&format_rpmpre,
       rpmRequires => \&format_rpmRequires,
     directories => \&format_directories,      directories => \&format_directories,
     directory => \&format_directory,      directory => \&format_directory,
     categoryname => \&format_categoryname,      categoryname => \&format_categoryname,
Line 317  exit; Line 416  exit;
 # ------------------------ Final output at end of markup parsing and formatting  # ------------------------ Final output at end of markup parsing and formatting
 sub end {  sub end {
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return "<br />THE END\n";   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";
   
     }      }
     if ($mode eq 'install') {      if ($mode eq 'install') {
  return '';   return '';
Line 336  sub format_lpml { Line 471  sub format_lpml {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
     my $date=`date`; chop $date;      my $date=`date`; chop $date;
     if ($mode eq 'html') {      if ($mode eq 'html') {
  $lpml = "<br />LPML BEGINNING: $date";   $lpml=<<END;
   <html>
   <head>
   <title>LPML Description Page
   (dist=$dist, categorytype=$categorytype, $date)</title>
   </head>
   <body>
   END
    $lpml .= "<br /><font size='+2'>LPML Description Page (dist=$dist, ".
       "categorytype=$categorytype, $date)".
       "</font>";
    $lpml .=<<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
           $lpml .=<<END;
   <br />&nbsp;<br /><a name='about' />
   <font size='+2'>About this file</font>
   <p>
   This file is generated dynamically by <tt>lpml_parse.pl</tt> as
   part of a development compilation process.</p>
   <p>LPML written by Scott Harrison (harris41\@msu.edu).
   </p>
   END
       }
       elsif ($mode eq 'text') {
    $lpml = "LPML Description Page (dist=$dist, $date)";
    $lpml .=<<END;
   
   * About this file
   * Software Package Description
   * Directory Structure
   * File Type Ownership and Permissions
   * Files
   END
           $lpml .=<<END;
   
   About this file
   
   This file is generated dynamically by lpml_parse.pl as
   part of a development compilation process.  Author: Scott
   Harrison (harris41\@msu.edu).
   
   END
     }      }
     elsif ($mode eq 'install') {      elsif ($mode eq 'install') {
  print '# LPML install targets. Linux Packaging Markup Language,';   print '# LPML install targets. Linux Packaging Markup Language,';
Line 401  sub format_categories { Line 586  sub format_categories {
     my $text=&trim($parser->get_text('/categories'));      my $text=&trim($parser->get_text('/categories'));
     $parser->get_tag('/categories');      $parser->get_tag('/categories');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $categories="\n<br />BEGIN CATEGORIES\n$text\n".   return $categories="\n<br />&nbsp;<br />".
     "<br />END CATEGORIES\n";      "\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 {      else {
  return '';   return '';
Line 413  sub format_category { Line 618  sub format_category {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
     $category_att_name=$tokeninfo[2]->{'name'};      $category_att_name=$tokeninfo[2]->{'name'};
     $category_att_type=$tokeninfo[2]->{'type'};      $category_att_type=$tokeninfo[2]->{'type'};
     $chmod='';$chown='';      $abbreviation=''; $chmod='';$chown='';
     $parser->get_text('/category');      $parser->get_text('/category');
     $parser->get_tag('/category');      $parser->get_tag('/category');
       $fab{$category_att_name}=$abbreviation;
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $category="\n<br />CATEGORY $category_att_name ".   if ($category_att_type eq $categorytype) {
     "$category_att_type $chmod $chown";      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 {      else {
  if ($category_att_type eq $categorytype) {   if ($category_att_type eq $categorytype) {
Line 429  sub format_category { Line 646  sub format_category {
  return '';   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  # -------------------------------------------------------- Format chown section
 sub format_chown {  sub format_chown {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 456  sub format_rpm { Line 684  sub format_rpm {
     my $text=&trim($parser->get_text('/rpm'));      my $text=&trim($parser->get_text('/rpm'));
     $parser->get_tag('/rpm');      $parser->get_tag('/rpm');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpm="\n<br />BEGIN RPM\n$text\n<br />END RPM";   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 {      else {
  return '';   return '';
Line 467  sub format_rpmSummary { Line 715  sub format_rpmSummary {
     my $text=&trim($parser->get_text('/rpmSummary'));      my $text=&trim($parser->get_text('/rpmSummary'));
     $parser->get_tag('/rpmSummary');      $parser->get_tag('/rpmSummary');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmSummary="\n<br />RPMSUMMARY $text";   return $rpmSummary="\nSummary     : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmSummary="\nSummary     : $text";
       }
       elsif ($mode eq 'make_rpm') {
    return <<END;
   <summary>$text</summary>
   END
     }      }
     else {      else {
  return '';   return '';
Line 478  sub format_rpmName { Line 734  sub format_rpmName {
     my $text=&trim($parser->get_text('/rpmName'));      my $text=&trim($parser->get_text('/rpmName'));
     $parser->get_tag('/rpmName');      $parser->get_tag('/rpmName');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmName="\n<br />RPMNAME $text";   return $rpmName="\nName        : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmName="\nName        : $text";
       }
       elsif ($mode eq 'make_rpm') {
    return <<END;
   <name>$text</name>
   END
     }      }
     else {      else {
  return '';   return '';
Line 489  sub format_rpmVersion { Line 753  sub format_rpmVersion {
     my $text=$parser->get_text('/rpmVersion');      my $text=$parser->get_text('/rpmVersion');
     $parser->get_tag('/rpmVersion');      $parser->get_tag('/rpmVersion');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmVersion="\n<br />RPMVERSION $text";   return $rpmVersion="\nVersion     : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmVersion="\nVersion     : $text";
     }      }
     else {      else {
  return '';   return '';
Line 500  sub format_rpmRelease { Line 767  sub format_rpmRelease {
     my $text=$parser->get_text('/rpmRelease');      my $text=$parser->get_text('/rpmRelease');
     $parser->get_tag('/rpmRelease');      $parser->get_tag('/rpmRelease');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmRelease="\n<br />RPMRELEASE $text";   return $rpmRelease="\nRelease     : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmRelease="\nRelease     : $text";
     }      }
     else {      else {
  return '';   return '';
Line 511  sub format_rpmVendor { Line 781  sub format_rpmVendor {
     my $text=$parser->get_text('/rpmVendor');      my $text=$parser->get_text('/rpmVendor');
     $parser->get_tag('/rpmVendor');      $parser->get_tag('/rpmVendor');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmVendor="\n<br />RPMVENDOR $text";   return $rpmVendor="\nVendor      : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmVendor="\nVendor      : $text";
       }
       elsif ($mode eq 'make_rpm') {
    return <<END;
   <vendor>$text</vendor>
   END
     }      }
     else {      else {
  return '';   return '';
Line 522  sub format_rpmBuildRoot { Line 800  sub format_rpmBuildRoot {
     my $text=$parser->get_text('/rpmBuildRoot');      my $text=$parser->get_text('/rpmBuildRoot');
     $parser->get_tag('/rpmBuildRoot');      $parser->get_tag('/rpmBuildRoot');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmBuildRoot="\n<br />RPMBUILDROOT $text";   return $rpmBuildRoot="\nBuild Root  : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmBuildRoot="\nBuild Root  : $text";
     }      }
     else {      else {
  return '';   return '';
Line 533  sub format_rpmCopyright { Line 814  sub format_rpmCopyright {
     my $text=$parser->get_text('/rpmCopyright');      my $text=$parser->get_text('/rpmCopyright');
     $parser->get_tag('/rpmCopyright');      $parser->get_tag('/rpmCopyright');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmCopyright="\n<br />RPMCOPYRIGHT $text";   return $rpmCopyright="\nLicense     : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmCopyright="\nLicense     : $text";
       }
       elsif ($mode eq 'make_rpm') {
    return <<END;
   <copyright>$text</copyright>
   END
     }      }
     else {      else {
  return '';   return '';
Line 544  sub format_rpmGroup { Line 833  sub format_rpmGroup {
     my $text=$parser->get_text('/rpmGroup');      my $text=$parser->get_text('/rpmGroup');
     $parser->get_tag('/rpmGroup');      $parser->get_tag('/rpmGroup');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmGroup="\n<br />RPMGROUP $text";   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 {      else {
  return '';   return '';
Line 555  sub format_rpmSource { Line 852  sub format_rpmSource {
     my $text=$parser->get_text('/rpmSource');      my $text=$parser->get_text('/rpmSource');
     $parser->get_tag('/rpmSource');      $parser->get_tag('/rpmSource');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmSource="\n<br />RPMSOURCE $text";   return $rpmSource="\nSource      : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmSource="\nSource      : $text";
     }      }
     else {      else {
  return '';   return '';
Line 566  sub format_rpmAutoReqProv { Line 866  sub format_rpmAutoReqProv {
     my $text=$parser->get_text('/rpmAutoReqProv');      my $text=$parser->get_text('/rpmAutoReqProv');
     $parser->get_tag('/rpmAutoReqProv');      $parser->get_tag('/rpmAutoReqProv');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmAutoReqProv="\n<br />RPMAUTOREQPROV $text";   return $rpmAutoReqProv="\nAutoReqProv : $text";
       }
       elsif ($mode eq 'text') {
    return $rpmAutoReqProv="\nAutoReqProv : $text";
       }
       elsif ($mode eq 'make_rpm') {
    return <<END;
   <AutoReqProv>$text</AutoReqProv>
   END
     }      }
     else {      else {
  return '';   return '';
Line 577  sub format_rpmdescription { Line 885  sub format_rpmdescription {
     my $text=$parser->get_text('/rpmdescription');      my $text=$parser->get_text('/rpmdescription');
     $parser->get_tag('/rpmdescription');      $parser->get_tag('/rpmdescription');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmdescription="\n<br />RPMDESCRIPTION $text";   $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 {      else {
  return '';   return '';
Line 588  sub format_rpmpre { Line 910  sub format_rpmpre {
     my $text=$parser->get_text('/rpmpre');      my $text=$parser->get_text('/rpmpre');
     $parser->get_tag('/rpmpre');      $parser->get_tag('/rpmpre');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $rpmpre="\n<br />RPMPRE $text";  # return $rpmpre="\n<br />RPMPRE $text";
    return '';
       }
       elsif ($mode eq 'make_rpm') {
    return <<END;
   <pre>$text</pre>
   END
     }      }
     else {      else {
  return '';   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  # -------------------------------------------------- Format directories section
 sub format_directories {  sub format_directories {
     my $text=$parser->get_text('/directories');      my $text=$parser->get_text('/directories');
     $parser->get_tag('/directories');      $parser->get_tag('/directories');
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $directories="\n<br />BEGIN DIRECTORIES\n$text\n<br />".   $text=~s/\[\{\{\{\{\{DPATHLENGTH\}\}\}\}\}\]/$dpathlength/g;
     "END DIRECTORIES\n";   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') {      elsif ($mode eq 'install') {
  return "\n".'directories:'."\n".$text;   return "\n".'directories:'."\n".$text;
    }      }
       elsif ($mode eq 'rpm_file_list') {
    return $text;
       }
       elsif ($mode eq 'uninstall_shell_commands') {
    return $text;
       }
     else {      else {
  return '';   return '';
     }      }
Line 612  sub format_directories { Line 987  sub format_directories {
 # ---------------------------------------------------- Format directory section  # ---------------------------------------------------- Format directory section
 sub format_directory {  sub format_directory {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
     $targetdir='';$categoryname='';$description='';      $targetdir='';$categoryname='';$description='';$protectionlevel='';
     $parser->get_text('/directory');      $parser->get_text('/directory');
     $parser->get_tag('/directory');      $parser->get_tag('/directory');
       $directory_count++;
       $categorycount{$categoryname}++;
     if ($mode eq 'html') {      if ($mode eq 'html') {
  return $directory="\n<br />DIRECTORY $targetdir $categoryname ".   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";      "$description";
     }      }
     elsif ($mode eq 'install') {      elsif ($mode eq 'install') {
  return "\t".'install '.$categoryhash{$categoryname}.' -d '.   return "\t".'install '.$categoryhash{$categoryname}.' -d '.
     $targetroot.'/'.$targetdir."\n";      $targetroot.'/'.$targetdir."\n";
     }      }
       elsif ($mode eq 'rpm_file_list') {
    return $targetroot.'/'.$targetdir."\n";
       }
       elsif ($mode eq 'uninstall_shell_commands') {
    if ($protectionlevel eq 'never_delete') {
       return 'echo "LEAVING BEHIND '.$targetroot.'/'.$targetdir.
    ' which may have important data worth saving"'."\n";
    }
    elsif ($protectionlevel eq 'weak_delete') {
       if ($targetdir!~/\w/) {
    die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ".
       "FILESYSTEM"."\n");
       }
       return 'rm -Rvf -i '.$targetroot.'/'.$targetdir."\n";
    }
    elsif ($protectionlevel =~ /never/) {
       die("CONFUSING PROTECTION LEVEL \"$protectionlevel\" FOUND ".
    "FOR directory $targetdir"."\n");
    }
    elsif ($protectionlevel !~
       /^never_delete|weak_delete|modest_delete|strong_delete|absolute_delete$/) {
       die("CONFUSING OR MISSING PROTECTION LEVEL \"$protectionlevel\" ".
    "FOUND FOR directory $targetdir\n");
    }
    else {
       if ($targetdir!~/\w/) {
    die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ".
       "FILESYSTEM"."\n");
       }
       return 'rm -Rvf '.$targetroot.'/'.$targetdir.
    "| grep 'removed directory'"."\n";
    }
       }
     else {      else {
  return '';   return '';
     }      }
Line 638  sub format_targetdir { Line 1066  sub format_targetdir {
     }      }
     return '';      return '';
 }  }
   # ---------------------------------------------- Format protectionlevel section
   sub format_protectionlevel {
       my @tokeninfo=@_;
       $protectionlevel='';
       my $text=&trim($parser->get_text('/protectionlevel'));
       if ($text) {
    $parser->get_tag('/protectionlevel');
    $protectionlevel=$text;
       }
       return '';
   }
 # ------------------------------------------------- Format categoryname section  # ------------------------------------------------- Format categoryname section
 sub format_categoryname {  sub format_categoryname {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 664  sub format_description { Line 1103  sub format_description {
 sub format_files {  sub format_files {
     my $text=$parser->get_text('/files');      my $text=$parser->get_text('/files');
     $parser->get_tag('/files');      $parser->get_tag('/files');
     if ($mode eq 'html') {      if ($mode eq 'MANIFEST') {
  return $directories="\n<br />BEGIN FILES\n$text\n<br />END FILES\n";   return $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') {      elsif ($mode eq 'install') {
  return "\n".'files:'."\n".$text.   return "\n".'files:'."\n".$text.
Line 685  sub format_files { Line 1144  sub format_files {
  foreach my $bi (@buildinfo) {   foreach my $bi (@buildinfo) {
     my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi);      my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi);
     $tword=''; $tword=' alwaysrun' if $trigger eq 'always run';       $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; 
     $command=~s/\/([^\/]*)$//;      if ($command!~/\s/) {
     $command2="cd $command; sh ./$1;\\";   $command=~s/\/([^\/]*)$//;
    $command2="cd $command; sh ./$1;\\";
       }
       else {
    $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
    $command2="cd $command; sh ./$2;\\";
       }
     my $depstring;      my $depstring;
     my $depstring2="\t\t\@echo '';\\\n";      my $depstring2="\t\t\@echo '';\\\n";
     my $olddep;      my $olddep;
Line 722  sub format_files { Line 1187  sub format_files {
  $binfo."\n".   $binfo."\n".
  "alwaysrun:\n\n";   "alwaysrun:\n\n";
     }      }
       elsif ($mode eq 'rpm_file_list') {
    return $text;
       }
     else {      else {
  return '';   return '';
     }      }
Line 752  sub format_file { Line 1220  sub format_file {
     $note=''; $build=''; $status=''; $dependencies='';      $note=''; $build=''; $status=''; $dependencies='';
     my $text=&trim($parser->get_text('/file'));      my $text=&trim($parser->get_text('/file'));
     my $buildtest;      my $buildtest;
       $file_count++;
       $categorycount{$categoryname}++;
     if ($source) {      if ($source) {
  $parser->get_tag('/file');   $parser->get_tag('/file');
  if ($mode eq 'html') {   if ($mode eq 'MANIFEST') {
     return ($file="\n<br />BEGIN FILE\n".      my $command=$build;
  "$source $target $categoryname $description $note " .      if ($command!~/\s/) {
  "$build $status $dependencies" .   $command=~s/\/([^\/]*)$//;
  "\nEND FILE");      }
       else {
    $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
       }
       $command=~s/^$sourceroot\///;
       my (@deps)=split(/\;/,$dependencies);
       my $retval=join("\n",($source,
          (map {"$command$_"} @deps)));
       return $retval."\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') {   elsif ($mode eq 'install' && $categoryname ne 'conf') {
     if ($build) {      if ($build) {
Line 772  sub format_file { Line 1270  sub format_file {
  foreach my $dep (@deps) {   foreach my $dep (@deps) {
     $depstring.=<<END;      $depstring.=<<END;
  ECODE=0; DEP=''; \\   ECODE=0; DEP=''; \\
  test -e $command/$dep || (echo '**** WARNING **** cannot evaluate status of dependency $command/$dep (for building ${sourceroot}/${source} with)'$logcmd); DEP="1"; \\   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 $command/$dep ${targetroot}/${target} || ECODE=\$\$?; } || DEP="1"; \\   [ -n DEP ] && { perl filecompare.pl -b2 $dep ${targetroot}/${target} || ECODE=\$\$?; } || DEP="1"; \\
  case "\$\$ECODE" in \\   case "\$\$ECODE" in \\
  2) echo "**** WARNING **** dependency $command/$dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\   2) echo "**** WARNING **** dependency $dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\
  esac; \\   esac; \\
 END  END
  }   }
Line 799  $buildtest \@if !(test -e "${sourceroot} Line 1297  $buildtest \@if !(test -e "${sourceroot}
  echo "**** ERROR **** CVS source file does not exist: ${sourceroot}/${source} and neither does target: ${targetroot}/${target}"$logcmd; \\   echo "**** ERROR **** CVS source file does not exist: ${sourceroot}/${source} and neither does target: ${targetroot}/${target}"$logcmd; \\
  elif !(test -e "${sourceroot}/${source}"); then \\   elif !(test -e "${sourceroot}/${source}"); then \\
  echo "**** WARNING **** CVS source file does not exist: ${sourceroot}/${source}"$logcmd; \\   echo "**** WARNING **** CVS source file does not exist: ${sourceroot}/${source}"$logcmd; \\
    perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
  else \\   else \\
  ECODE=0; \\   ECODE=0; \\
  perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${target} || ECODE=\$\$?; \\   perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${target} || ECODE=\$\$?; \\
  case "\$\$ECODE" in \\   case "\$\$ECODE" in \\
  1) echo "${targetroot}/${target} is unchanged";; \\   1) echo "${targetroot}/${target} is unchanged";; \\
  2) echo "**** WARNING **** target file ${targetroot}/${target} is newer than CVS source; creating ${targetroot}/${target}.lpmlnewfile instead"$logcmd && install -o www -g www -m 0500 ${sourceroot}/${source} ${targetroot}/${target}.lpmlnewfile;; \\   2) echo "**** WARNING **** target file ${targetroot}/${target} is newer than CVS source; saving current (old) target file to ${targetroot}/${target}.lpmlsave and then overwriting"$logcmd && install -o www -g www -m 0600 ${targetroot}/${target} ${targetroot}/${target}.lpmlsave && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
  0) echo "install -o www -g www -m 0500 ${sourceroot}/${source} ${targetroot}/${target}" && install -o www -g www -m 0500 ${sourceroot}/${source} ${targetroot}/${target};; \\   0) echo "install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
  esac; \\   esac; \\
    perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
  fi   fi
 END  END
 #    return "\t".'@test -e '.$sourceroot.'/'.$source.  
 # ' && perl filecompare.pl -b '.$sourceroot.'/'.$source.' '.  
 # $targetroot.'/'.$target.  
 # ' && install '.  
 # $categoryhash{$categoryname}.' '.  
 # $sourceroot.'/'.$source.' '.  
 # $targetroot.'/'.$target.  
 # ' || echo "**** WARNING '.  
 # '**** CVS source file does not exist: '.$sourceroot.'/'.  
 # $source.'"'."\n";  
  }   }
  elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {   elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
     push @configall,$targetroot.'/'.$target;      push @configall,$targetroot.'/'.$target;
     return $targetroot.'/'.$target.': alwaysrun'."\n".      return $targetroot.'/'.$target.': alwaysrun'."\n".
  "\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 '.$sourceroot.'/'.$source.' '.$targetroot.'/'.$target.' || ECODE=$$?; } && { [ $$ECODE != "2" ] || (install '.$categoryhash{$categoryname}.' '.   "\t".'@# Compare source with target and intelligently respond'.
  $sourceroot.'/'.$source.' '.   "\n\t\n\t\n".
  $targetroot.'/'.$target.'.lpmlnewconf'.  
   
    "\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 \\'.
    "\n\t".$sourceroot.'/'.$source." \\\n\t".
    $targetroot.'/'.$target." \\\n\t".
    ' || ECODE=$$?; } && '."\\\n\t"."\\\n\t"."\\\n\t".
   
   
    '{ [ $$ECODE != "2" ] || '." \\\n\t".'(install '.
                   $categoryhash{$categoryname}." \\\n\t\t".
    $sourceroot.'/'.$source." \\\n\t\t".
    $targetroot.'/'.$target.'.lpmlnew'." \\\n\t\t".
  ' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'.   ' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'.
  $logcmd.' && echo "'.   " \\\n\t\t".$logcmd.' && '." \\\n\t\t"."echo -n \"".
  'You likely need to compare contents of '.   'You likely need to compare contents of "'."\\\n\t\t\t".
  ''.$targetroot.'/'.$target.' with the new '.   '&& echo -n "'.$targetroot.'/'.$target.'"'."\\\n\t\t".
                 ''.$targetroot.'/'.$target.'.lpmlnewconf"'.   '&& echo -n " with the new "'."\\\n\t\t\t".
  "$logcmd); };\n\n";                  '&& echo "'.$targetroot.'/'.$target.'.lpmlnew"'."\\\n\t\t".
    "$logcmd); } && "." \\\n\t"."\\\n\t"."\\\n\t".
   
   
    '{ [ $$ECODE != "3" ] || '."\\\n\t".
    '(install '.
                   $categoryhash{$categoryname}."\\\n\t\t".
    $sourceroot.'/'.$source."\\\n\t\t".
    $targetroot.'/'.$target."\\\n\t\t".
    ' && echo "**** WARNING: NEW CONFIGURATION FILE ADDED ****"'.
    "\\\n\t\t".$logcmd.' && '."\\\n\t\t".
    'echo -n "'.
    'You likely need to review the contents of "'."\\\n\t\t\t".
    '&& echo -n "'.
    $targetroot.'/'.$target.'"'."\\\n\t\t\t".
    '&& echo -n "'.
    ' to make sure its "'."\\\n\t\t".
    '&& echo "'.
                   'settings are compatible with your overall system"'."\\\n\t\t".
    "$logcmd); } && "."\\\n\t"."\\\n\t"."\\\n\t".
   
   
    '{ [ $$ECODE != "1" ] || ('."\\\n\t\t".
    'echo "**** ERROR ****"'.$logcmd.' && '."\\\n\t\t".'echo -n "'.
    'Configuration source file does not exist "'."\\\n\t\t".
    '&& echo -n "'.$sourceroot.'/'.$source.'"'."\\\n\t\t".
    "$logcmd); } && "."\\\n\t\t".
    "perl verifymodown.pl ${targetroot}/${target} "."\\\n\t\t\t".
    "\"$categoryhash{$categoryname}\""."\\\n\t\t\t".
    "$logcmd;\n\n";
  }   }
  elsif ($mode eq 'build' && $build) {   elsif ($mode eq 'build' && $build) {
     push @buildall,$sourceroot.'/'.$source;      push @buildall,$sourceroot.'/'.$source;
Line 840  END Line 1370  END
  $dependencies;   $dependencies;
 #    return '# need to build '.$source.";  #    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 {   else {
     return '';      return '';
  }   }
Line 849  END Line 1390  END
 # --------------------------------------------------------- Format link section  # --------------------------------------------------------- Format link section
 sub format_link {  sub format_link {
     my @tokeninfo=@_;      my @tokeninfo=@_;
     $link=''; $linkto=''; $target=''; $categoryname=''; $description='';      $link=''; $linkto=''; $source=''; $target=''; $categoryname=''; 
     $note=''; $build=''; $status=''; $dependencies='';      $description=''; $note=''; $build=''; $status=''; $dependencies='';
     my $text=&trim($parser->get_text('/link'));      my $text=&trim($parser->get_text('/link'));
     if ($linkto) {      if ($linkto) {
  $parser->get_tag('/link');   $parser->get_tag('/link');
  if ($mode eq 'html') {   if ($mode eq 'html') {
     return $link="\n<br />BEGIN LINK\n".      my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
  "$linkto $target $categoryname $description $note " .      $link_count+=scalar(@targets);
  "$build $status $dependencies" .      foreach my $tgt (@targets) {
     "\nEND LINK";   $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') {   elsif ($mode eq 'install') {
     my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);      my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
     foreach my $tgt (@targets) {      foreach my $tgt (@targets) {
  push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt.   push @links,"\t".'ln -fs /'.$linkto.' '.$targetroot.'/'.$tgt.
     "\n";      "\n";
     }      }
   #    return join('',@links);
     return '';      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 {   else {
     return '';      return '';
  }   }
Line 882  sub format_fileglob { Line 1461  sub format_fileglob {
     $note=''; $build=''; $status=''; $dependencies='';      $note=''; $build=''; $status=''; $dependencies='';
     $filenames='';      $filenames='';
     my $text=&trim($parser->get_text('/fileglob'));      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;
     if ($sourcedir) {      if ($sourcedir) {
  $parser->get_tag('/fileglob');   $parser->get_tag('/fileglob');
  if ($mode eq 'html') {   if ($mode eq 'MANIFEST') {
     return $fileglob="\n<br />BEGIN FILEGLOB\n".           return join("\n",(map {"$sourcedir$_"} split(/\;/,$filenames2)))."\n";
  "$glob sourcedir $targetdir $categoryname $description $note ".   }
  "$build $status $dependencies $filenames" .   elsif ($mode eq 'html') {
     "\nEND FILEGLOB";      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') {   elsif ($mode eq 'install') {
       my $eglob=$glob;
       if ($glob eq '*') {
    $eglob='[^C][^V][^S]'.$glob;
       }
     return "\t".'install '.      return "\t".'install '.
  $categoryhash{$categoryname}.' '.   $categoryhash{$categoryname}.' '.
  $sourceroot.'/'.$sourcedir.'[^C][^V][^S]'.$glob.' '.   $sourceroot.'/'.$sourcedir.$eglob.' '.
  $targetroot.'/'.$targetdir.'.'."\n";   $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 {   else {
     return '';      return '';
  }   }
Line 939  sub format_source { Line 1557  sub format_source {
 sub format_note {  sub format_note {
     my @tokeninfo=@_;      my @tokeninfo=@_;
     $note='';      $note='';
     my $text=&trim($parser->get_text('/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) {      if ($text) {
  $parser->get_tag('/note');  # $parser->get_tag('/note');
  $note=$text;   $note=$text;
     }      }
     return '';      return '';
Line 955  sub format_build { Line 1589  sub format_build {
     if ($text) {      if ($text) {
  $parser->get_tag('/build');   $parser->get_tag('/build');
  $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};   $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
    $build=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines
     }      }
     return '';      return '';
 }  }
Line 1013  sub format_filenames { Line 1648  sub format_filenames {
     }      }
     return '';      return '';
 }  }
   # ----------------------------------------------- Format specialnotices section
   sub format_specialnotices {
       $parser->get_tag('/specialnotices');
       return '';
   }
   # ------------------------------------------------ Format specialnotice section
   sub format_specialnotice {
       $parser->get_tag('/specialnotice');
       return '';
   }
 # ------------------------------------------------------- Format linkto section  # ------------------------------------------------------- Format linkto section
 sub format_linkto {  sub format_linkto {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 1037  sub trim { Line 1682  sub trim {
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
   =pod
   
 =head1 NAME  =head1 NAME
   
 lpml_parse.pl - This is meant to parse files meeting the lpml document type.  lpml_parse.pl - This is meant to parse files meeting the lpml document type.
 See lpml.dtd.  LPML=Linux Packaging Markup Language.  
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 Usage is for lpml file to come in through standard input.  <STDIN> | perl lpml_parse.pl <MODE> <CATEGORY> <DIST> <SOURCE> <TARGET>
   
   Usage is for the lpml file to come in through standard input.
   
 =over 4  =over 4
   
Line 1076  Only the 1st argument is mandatory for t Line 1724  Only the 1st argument is mandatory for t
 Example:  Example:
   
 cat ../../doc/loncapafiles.lpml |\\  cat ../../doc/loncapafiles.lpml |\\
 perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install  perl lpml_parse.pl html runtime default /home/sherbert/loncapa /tmp/install
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 I am using a multiple pass-through approach to parsing  The general flow of the script is to get command line arguments, run through
 the lpml file.  This saves memory and makes sure the server  the XML document three times, and output according to any desired mode:
 will never be overloaded.  install, configinstall, build, rpm, dpkg, htmldoc, textdoc, and status.
   
   A number of coding decisions are made according to the following principle:
   installation software must be stand-alone.  Therefore, for instance, I try
   not to use the GetOpt::Long module or any other perl modules.  (I do however
   use HTML::TokeParser.)  I also have tried to keep all the MODES of
   parsing inside this file.  Therefore, format_TAG subroutines are fairly
   lengthy with their conditional logic.  A more "elegant" solution might
   be to dynamically register the parsing mode and subroutines, or maybe even work
   with stylesheets.  However, in order to make this the installation back-bone
   of choice, there are advantages for HAVING EVERYTHING IN ONE FILE.
   This way, the LPML installation software does not have to rely on OTHER
   installation software (a chicken versus the egg problem).  Besides, I would
   suggest the modes of parsing are fairly constant: install, configinstall,
   build, rpm, dpkg, htmldoc, textdoc, and status.
   
   Another coding decision is about using a multiple pass-through approach to
   parsing the lpml file.  This saves memory and makes sure the server will never
   be overloaded.  During the first pass-through, the script gathers information
   specific as to resolving what tags with what 'dist=' attributes are to be used.
   During the second pass-through, the script cleans up white-space surrounding
   the XML tags, and filters through the tags based on information regarding the
   'dist=' attributes (information gathered in the first pass-through).
   The third and final pass-through involves formatting and rendering the XML
   into whatever XML mode is chosen: install, configinstall, build, rpm, dpkg,
   htmldoc, textdoc, and status.
   
   The hierarchy mandated by the DTD does not always correspond to the hierarchy
   that is sensible for a Makefile.  For instance, in a Makefile it is sensible
   that soft-links are installed after files.  However, in an LPML document, it
   is sensible that files and links be considered together and the writer of the
   LPML document should be free to place things in whatever order makes best
   sense in terms of LOOKING at the information.  The complication that arises
   is that the parser needs to have a memory for passing values from
   leaves on the XML tree to higher-up branches.  Currently, this memory is
   hard-coded (like with the @links array), but it may benefit from a more
   formal approach in the future.
   
 =head1 README  =head1 README
   
 I am using a multiple pass-through approach to parsing  This parses an LPML file to generate information useful for
 the lpml file.  This saves memory and makes sure the server  source to target installation, compilation, filesystem status
 will never be overloaded.  checking, RPM and Debian software packaging, and documentation.
   
   More information on LPML is available at http://lpml.sourceforge.net.
   
 =head1 PREREQUISITES  =head1 PREREQUISITES
   
Line 1102  linux Line 1788  linux
   
 =head1 SCRIPT CATEGORIES  =head1 SCRIPT CATEGORIES
   
 Packaging/Administrative  UNIX/System_administration
   
   =head1 AUTHOR
   
    Scott Harrison
    codeharrison@yahoo.com
   
   Please let me know how/if you are finding this script useful and
   any/all suggestions.  -Scott
   
 =cut  =cut
Removed from v.1.19  
changed lines
  Added in v.1.51

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>