Annotation of nsdl/build/lpml_parse.pl, revision 1.1
1.1 ! harris41 1: #!/usr/bin/perl
! 2:
! 3: # -------------------------------------------------------- Documentation notice
! 4: # Run "perldoc ./lpml_parse.pl" in order to best view the software
! 5: # documentation internalized in this program.
! 6:
! 7: # --------------------------------------------------------- Distribution notice
! 8: # This script is distributed with the LPML software project available at
! 9: # http://lpml.sourceforge.net
! 10:
! 11: # --------------------------------------------------------- License Information
! 12: # The LearningOnline Network with CAPA
! 13: # lpml_parse.pl - Linux Packaging Markup Language parser
! 14: #
! 15: # $Id: lpml_parse.pl,v 1.47 2002/04/26 15:53:00 harris41 Exp $
! 16: #
! 17: # Written by Scott Harrison, codeharrison@yahoo.com
! 18: #
! 19: # Copyright Michigan State University Board of Trustees
! 20: #
! 21: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 22: #
! 23: # LON-CAPA is free software; you can redistribute it and/or modify
! 24: # it under the terms of the GNU General Public License as published by
! 25: # the Free Software Foundation; either version 2 of the License, or
! 26: # (at your option) any later version.
! 27: #
! 28: # LON-CAPA is distributed in the hope that it will be useful,
! 29: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 30: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 31: # GNU General Public License for more details.
! 32: #
! 33: # You should have received a copy of the GNU General Public License
! 34: # along with LON-CAPA; if not, write to the Free Software
! 35: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 36: #
! 37: # /home/httpd/html/adm/gpl.txt
! 38: #
! 39: # http://www.lon-capa.org/
! 40: #
! 41: # YEAR=2001
! 42: # May 2001
! 43: # 06/19/2001,06/20,06/24 - Scott Harrison
! 44: # 9/5/2001,9/6,9/7,9/8 - Scott Harrison
! 45: # 9/17,9/18 - Scott Harrison
! 46: # 11/4,11/5,11/6,11/7,11/16,11/17 - Scott Harrison
! 47: # 12/2,12/3,12/4,12/5,12/6,12/13,12/19,12/29 - Scott Harrison
! 48: # YEAR=2002
! 49: # 1/8,1/9,1/29,1/31,2/5,3/21,4/8,4/12 - Scott Harrison
! 50: #
! 51: ###
! 52:
! 53: ###############################################################################
! 54: ## ##
! 55: ## ORGANIZATION OF THIS PERL SCRIPT ##
! 56: ## 1. Notes ##
! 57: ## 2. Get command line arguments ##
! 58: ## 3. First pass through (grab distribution-specific information) ##
! 59: ## 4. Second pass through (parse out what is not necessary) ##
! 60: ## 5. Third pass through (translate markup according to specified mode) ##
! 61: ## 6. Functions (most all just format contents of different markup tags) ##
! 62: ## 7. POD (plain old documentation, CPAN style) ##
! 63: ## ##
! 64: ###############################################################################
! 65:
! 66: # ----------------------------------------------------------------------- Notes
! 67: #
! 68: # I am using a multiple pass-through approach to parsing
! 69: # the lpml file. This saves memory and makes sure the server
! 70: # will never be overloaded.
! 71: #
! 72: # This is meant to parse files meeting the lpml document type.
! 73: # See lpml.dtd. LPML=Linux Packaging Markup Language.
! 74:
! 75: use HTML::TokeParser;
! 76:
! 77: my $usage=<<END;
! 78: **** ERROR ERROR ERROR ERROR ****
! 79: Usage is for lpml file to come in through standard input.
! 80: 1st argument is the mode of parsing:
! 81: install,configinstall,build,rpm,dpkg,htmldoc,textdoc,status
! 82: 2nd argument is the category permissions to use:
! 83: typical choices: runtime,development
! 84: 3rd argument is the distribution:
! 85: typical choices: default,redhat6.2,debian2.2,redhat7
! 86: 4th argument is to manually specify a sourceroot.
! 87: 5th argument is to manually specify a targetroot.
! 88:
! 89: Only the 1st argument is mandatory for the program to run.
! 90:
! 91: Example:
! 92:
! 93: cat ../../doc/loncapafiles.lpml |\\
! 94: perl lpml_parse.pl html development default /home/sherbert/loncapa /tmp/install
! 95:
! 96: For more information, type "perldoc lpml_parse.pl".
! 97: END
! 98:
! 99: # ------------------------------------------------- Grab command line arguments
! 100:
! 101: my $mode='';
! 102: if (@ARGV==5) {
! 103: $mode = shift @ARGV;
! 104: }
! 105: else {
! 106: @ARGV=();shift @ARGV;
! 107: while(<>){} # throw away the input to avoid broken pipes
! 108: print $usage;
! 109: exit -1; # exit with error status
! 110: }
! 111:
! 112: my $categorytype='';
! 113: if (@ARGV) {
! 114: $categorytype = shift @ARGV;
! 115: }
! 116:
! 117: my $dist='';
! 118: if (@ARGV) {
! 119: $dist = shift @ARGV;
! 120: }
! 121:
! 122: my $targetroot='';
! 123: my $sourceroot='';
! 124: my $targetrootarg='';
! 125: my $sourcerootarg='';
! 126: if (@ARGV) {
! 127: $sourceroot = shift @ARGV;
! 128: }
! 129: if (@ARGV) {
! 130: $targetroot = shift @ARGV;
! 131: }
! 132: $sourceroot=~s/\/$//; # remove trailing directory slash
! 133: $targetroot=~s/\/$//; # remove trailing directory slash
! 134: $sourcerootarg=$sourceroot;
! 135: $targetrootarg=$targetroot;
! 136:
! 137: my $logcmd='| tee -a WARNINGS';
! 138:
! 139: my $invocation; # Record how the program was invoked
! 140: # --------------------------------------------------- Record program invocation
! 141: if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
! 142: $invocation=(<<END);
! 143: # Invocation: STDINPUT | lpml_parse.pl
! 144: # 1st argument (mode) is: $mode
! 145: # 2nd argument (category type) is: $categorytype
! 146: # 3rd argument (distribution) is: $dist
! 147: # 4th argument (sourceroot) is: described below
! 148: # 5th argument (targetroot) is: described below
! 149: END
! 150: }
! 151:
! 152: # -------------------------- Start first pass through (just gather information)
! 153: my @parsecontents=<>;
! 154: my $parsestring=join('',@parsecontents);
! 155:
! 156: # Need to make a pass through and figure out what defaults are
! 157: # overrided. Top-down overriding strategy (tree leaves don't know
! 158: # about distant tree leaves).
! 159:
! 160: my @hierarchy;
! 161: $hierarchy[0]=0;
! 162: my $hloc=0;
! 163: my $token;
! 164: $parser = HTML::TokeParser->new(\$parsestring) or
! 165: die('can\'t create TokeParser object');
! 166: $parser->xml_mode('1');
! 167: my %setting;
! 168:
! 169: # Values for the %setting hash
! 170: my $defaultset=1; # a default setting exists for a key
! 171: my $distset=2; # a distribution setting exists for a key
! 172: # (overrides default setting)
! 173:
! 174: my $key=''; # this is a unique key identifier (the token name with its
! 175: # coordinates inside the hierarchy)
! 176: while ($token = $parser->get_token()) { # navigate through $parsestring
! 177: if ($token->[0] eq 'S') {
! 178: $hloc++;
! 179: $hierarchy[$hloc]++;
! 180: $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
! 181: my $thisdist=' '.$token->[2]{'dist'}.' ';
! 182: if ($thisdist eq ' default ') {
! 183: $setting{$key}=$defaultset;
! 184: }
! 185: elsif (length($dist)>0 &&
! 186: $setting{$key}==$defaultset &&
! 187: $thisdist=~/\s$dist\s/) {
! 188: $setting{$key}=$distset;
! 189: # disregard default setting for this key if
! 190: # there is a directly requested distribution match
! 191: # (in other words, there must first be a default
! 192: # setting for a key in order for it to be overridden)
! 193: }
! 194: }
! 195: if ($token->[0] eq 'E') {
! 196: $hloc--;
! 197: }
! 198: }
! 199:
! 200: # - Start second pass through (clean up the string to allow for easy rendering)
! 201:
! 202: # The string is cleaned up so that there is no white-space surrounding any
! 203: # XML tag. White-space inside text 'T' elements is preserved.
! 204:
! 205: # Clear up memory
! 206: undef($hloc);
! 207: undef(@hierarchy);
! 208: undef($parser);
! 209: $hierarchy[0]=0; # initialize hierarchy
! 210: $parser = HTML::TokeParser->new(\$parsestring) or
! 211: die('can\'t create TokeParser object');
! 212: $parser->xml_mode('1');
! 213: my $cleanstring; # contains the output of the second step
! 214: while ($token = $parser->get_token()) { # navigate through $parsestring
! 215: if ($token->[0] eq 'S') { # a start tag
! 216: $hloc++;
! 217: $hierarchy[$hloc]++;
! 218: $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
! 219:
! 220: # Surround tagdist (the dist attribute of an XML tag)
! 221: # with white-space to allow for uniform searching a few
! 222: # lines below here.
! 223: my $tagdist=' '.$token->[2]{'dist'}.' ';
! 224:
! 225: # This conditional clause is set up to ignore two sets
! 226: # of invalid conditions before accepting entry into
! 227: # $cleanstring.
! 228:
! 229: # Condition #1: Ignore this part of the string if the tag
! 230: # has a superior distribution-specific setting and the tag
! 231: # being evaluated has a dist setting something other than
! 232: # blank or $dist.
! 233: if ($setting{$key}==$distset and
! 234: !($tagdist eq ' ' or $tagdist =~/\s$dist\s/)) {
! 235: if ($token->[4]!~/\/>$/) {
! 236: $parser->get_tag('/'.$token->[1]);
! 237: $hloc--;
! 238: }
! 239: }
! 240: # Condition #2: Ignore this part of the string if the tag has
! 241: # is not blank and does not equal dist and
! 242: # either does not equal default or it has a prior $dist-specific
! 243: # setting.
! 244: elsif ($tagdist ne ' ' and $tagdist!~/\s$dist\s/ and
! 245: !($tagdist eq ' default ' and $setting{$key}!=$distset)) {
! 246: if ($token->[4]!~/\/>$/) {
! 247: $parser->get_tag('/'.$token->[1]);
! 248: $hloc--;
! 249: }
! 250: }
! 251: # In other words, output to $cleanstring if the tag is dist=default
! 252: # or if the tag is set to dist=$dist for the first time. And, always
! 253: # output when dist='' is not present.
! 254: else {
! 255: $cleanstring.=$token->[4];
! 256: }
! 257: }
! 258: # Note: this loop DOES work with <tag /> style markup as well as
! 259: # <tag></tag> style markup since I always check for $token->[4] ending
! 260: # with "/>".
! 261: if ($token->[0] eq 'E') { # an end tag
! 262: $cleanstring.=$token->[2];
! 263: $hloc--;
! 264: }
! 265: if ($token->[0] eq 'T') { # text contents inside tags
! 266: $cleanstring.=$token->[1];
! 267: }
! 268: }
! 269: $cleanstring=&trim($cleanstring);
! 270: $cleanstring=~s/\>\s*\n\s*\</\>\</g;
! 271:
! 272: # -------------------------------------------- Start final (third) pass through
! 273:
! 274: # storage variables
! 275: my $lpml;
! 276: my $categories;
! 277: my @categorynamelist;
! 278: my $category;
! 279: my $category_att_name;
! 280: my $category_att_type;
! 281: my $chown;
! 282: my $chmod;
! 283: my $abbreviation; # space-free abbreviation; esp. for image names
! 284: my $rpm;
! 285: my $rpmSummary;
! 286: my $rpmName;
! 287: my $rpmVersion;
! 288: my $rpmRelease;
! 289: my $rpmVendor;
! 290: my $rpmBuildRoot;
! 291: my $rpmCopyright;
! 292: my $rpmGroup;
! 293: my $rpmSource;
! 294: my $rpmAutoReqProv;
! 295: my $rpmdescription;
! 296: my $rpmpre;
! 297: my $directories;
! 298: my $directory;
! 299: my $targetdirs;
! 300: my $targetdir;
! 301: my $categoryname;
! 302: my $description;
! 303: my $files;
! 304: my $fileglobs;
! 305: my $links;
! 306: my $file;
! 307: my $link;
! 308: my $fileglob;
! 309: my $sourcedir;
! 310: my $targets;
! 311: my $target;
! 312: my $source;
! 313: my $note;
! 314: my $build;
! 315: my $buildlink;
! 316: my $commands;
! 317: my $command;
! 318: my $status;
! 319: my $dependencies;
! 320: my $dependency;
! 321: my @links;
! 322: my %categoryhash;
! 323: my $dpathlength;
! 324: my %fab; # file category abbreviation
! 325: my $directory_count;
! 326: my $file_count;
! 327: my $link_count;
! 328: my $fileglob_count;
! 329: my $fileglobnames_count;
! 330: my %categorycount;
! 331:
! 332: my @buildall;
! 333: my @buildinfo;
! 334:
! 335: my @configall;
! 336:
! 337: # Make new parser with distribution specific input
! 338: undef $parser;
! 339: $parser = HTML::TokeParser->new(\$cleanstring) or
! 340: die('can\'t create TokeParser object');
! 341: $parser->xml_mode('1');
! 342:
! 343: # Define handling methods for mode-dependent text rendering
! 344:
! 345: $parser->{textify}={
! 346: specialnotices => \&format_specialnotices,
! 347: specialnotice => \&format_specialnotice,
! 348: targetroot => \&format_targetroot,
! 349: sourceroot => \&format_sourceroot,
! 350: categories => \&format_categories,
! 351: category => \&format_category,
! 352: abbreviation => \&format_abbreviation,
! 353: targetdir => \&format_targetdir,
! 354: chown => \&format_chown,
! 355: chmod => \&format_chmod,
! 356: rpm => \&format_rpm,
! 357: rpmSummary => \&format_rpmSummary,
! 358: rpmName => \&format_rpmName,
! 359: rpmVersion => \&format_rpmVersion,
! 360: rpmRelease => \&format_rpmRelease,
! 361: rpmVendor => \&format_rpmVendor,
! 362: rpmBuildRoot => \&format_rpmBuildRoot,
! 363: rpmCopyright => \&format_rpmCopyright,
! 364: rpmGroup => \&format_rpmGroup,
! 365: rpmSource => \&format_rpmSource,
! 366: rpmAutoReqProv => \&format_rpmAutoReqProv,
! 367: rpmdescription => \&format_rpmdescription,
! 368: rpmpre => \&format_rpmpre,
! 369: rpmRequires => \&format_rpmRequires,
! 370: directories => \&format_directories,
! 371: directory => \&format_directory,
! 372: categoryname => \&format_categoryname,
! 373: description => \&format_description,
! 374: files => \&format_files,
! 375: file => \&format_file,
! 376: fileglob => \&format_fileglob,
! 377: links => \&format_links,
! 378: link => \&format_link,
! 379: linkto => \&format_linkto,
! 380: source => \&format_source,
! 381: target => \&format_target,
! 382: note => \&format_note,
! 383: build => \&format_build,
! 384: status => \&format_status,
! 385: dependencies => \&format_dependencies,
! 386: buildlink => \&format_buildlink,
! 387: glob => \&format_glob,
! 388: sourcedir => \&format_sourcedir,
! 389: filenames => \&format_filenames,
! 390: };
! 391:
! 392: my $text;
! 393: my $token;
! 394: undef $hloc;
! 395: undef @hierarchy;
! 396: my $hloc;
! 397: my @hierarchy2;
! 398: while ($token = $parser->get_tag('lpml')) {
! 399: &format_lpml(@{$token});
! 400: $text = &trim($parser->get_text('/lpml'));
! 401: $token = $parser->get_tag('/lpml');
! 402: print $lpml;
! 403: print "\n";
! 404: # $text=~s/\s*\n\s*\n\s*/\n/g;
! 405: print $text;
! 406: print "\n";
! 407: print &end();
! 408: }
! 409: exit;
! 410:
! 411: # ---------- Functions (most all just format contents of different markup tags)
! 412:
! 413: # ------------------------ Final output at end of markup parsing and formatting
! 414: sub end {
! 415: if ($mode eq 'html') {
! 416: return "<br /> <br />".
! 417: "<a name='summary' /><font size='+2'>Summary of Source Repository".
! 418: "</font>".
! 419: "<br /> <br />".
! 420: "<table border='1' cellpadding='5'>".
! 421: "<caption>Files, Directories, and Symbolic Links</caption>".
! 422: "<tr><td>Files (not referenced by globs)</td><td>$file_count</td>".
! 423: "</tr>".
! 424: "<tr><td>Files (referenced by globs)</td>".
! 425: "<td>$fileglobnames_count</td>".
! 426: "</tr>".
! 427: "<tr><td>Total Files</td>".
! 428: "<td>".($fileglobnames_count+$file_count)."</td>".
! 429: "</tr>".
! 430: "<tr><td>File globs</td>".
! 431: "<td>".$fileglob_count."</td>".
! 432: "</tr>".
! 433: "<tr><td>Directories</td>".
! 434: "<td>".$directory_count."</td>".
! 435: "</tr>".
! 436: "<tr><td>Symbolic links</td>".
! 437: "<td>".$link_count."</td>".
! 438: "</tr>".
! 439: "</table>".
! 440: "<table border='1' cellpadding='5'>".
! 441: "<caption>File Category Count</caption>".
! 442: "<tr><th>Icon</th><th>Name</th><th>Number of Occurrences</th>".
! 443: "<th>Number of Incorrect Counts</th>".
! 444: "</tr>".
! 445: join("\n",(map {"<tr><td><img src='$fab{$_}.gif' ".
! 446: "alt='$_ icon' /></td>".
! 447: "<td>$_</td><td>$categorycount{$_}</td>".
! 448: "<td><!-- POSTEVALINLINE $_ --></td></tr>"}
! 449: @categorynamelist)).
! 450: "</table>".
! 451: "</body></html>\n";
! 452:
! 453: }
! 454: if ($mode eq 'install') {
! 455: return '';
! 456: }
! 457: }
! 458:
! 459: # ----------------------- Take in string to parse and the separation expression
! 460: sub extract_array {
! 461: my ($stringtoparse,$sepexp) = @_;
! 462: my @a=split(/$sepexp/,$stringtoparse);
! 463: return \@a;
! 464: }
! 465:
! 466: # --------------------------------------------------------- Format lpml section
! 467: sub format_lpml {
! 468: my (@tokeninfo)=@_;
! 469: my $date=`date`; chop $date;
! 470: if ($mode eq 'html') {
! 471: $lpml=<<END;
! 472: <html>
! 473: <head>
! 474: <title>LPML Description Page
! 475: (dist=$dist, categorytype=$categorytype, $date)</title>
! 476: </head>
! 477: <body>
! 478: END
! 479: $lpml .= "<br /><font size='+2'>LPML Description Page (dist=$dist, ".
! 480: "categorytype=$categorytype, $date)".
! 481: "</font>";
! 482: $lpml .=<<END;
! 483: <ul>
! 484: <li><a href='#about'>About this file</a></li>
! 485: <li><a href='#ownperms'>File Type Ownership and Permissions
! 486: Descriptions</a></li>
! 487: <li><a href='#package'>Software Package Description</a></li>
! 488: <li><a href='#directories'>Directory Structure</a></li>
! 489: <li><a href='#files'>Files</a></li>
! 490: <li><a href='#summary'>Summary of Source Repository</a></li>
! 491: </ul>
! 492: END
! 493: $lpml .=<<END;
! 494: <br /> <br /><a name='about' />
! 495: <font size='+2'>About this file</font>
! 496: <p>
! 497: This file is generated dynamically by <tt>lpml_parse.pl</tt> as
! 498: part of a development compilation process.</p>
! 499: <p>LPML written by Scott Harrison (harris41\@msu.edu).
! 500: </p>
! 501: END
! 502: }
! 503: elsif ($mode eq 'text') {
! 504: $lpml = "LPML Description Page (dist=$dist, $date)";
! 505: $lpml .=<<END;
! 506:
! 507: * About this file
! 508: * Software Package Description
! 509: * Directory Structure
! 510: * File Type Ownership and Permissions
! 511: * Files
! 512: END
! 513: $lpml .=<<END;
! 514:
! 515: About this file
! 516:
! 517: This file is generated dynamically by lpml_parse.pl as
! 518: part of a development compilation process. Author: Scott
! 519: Harrison (harris41\@msu.edu).
! 520:
! 521: END
! 522: }
! 523: elsif ($mode eq 'install') {
! 524: print '# LPML install targets. Linux Packaging Markup Language,';
! 525: print ' by Scott Harrison 2001'."\n";
! 526: print '# This file was automatically generated on '.`date`;
! 527: print "\n".$invocation;
! 528: $lpml .= "SHELL=\"/bin/bash\"\n\n";
! 529: }
! 530: elsif ($mode eq 'configinstall') {
! 531: print '# LPML configuration file targets (configinstall).'."\n";
! 532: print '# Linux Packaging Markup Language,';
! 533: print ' by Scott Harrison 2001'."\n";
! 534: print '# This file was automatically generated on '.`date`;
! 535: print "\n".$invocation;
! 536: $lpml .= "SHELL=\"/bin/bash\"\n\n";
! 537: }
! 538: elsif ($mode eq 'build') {
! 539: $lpml = "# LPML build targets. Linux Packaging Markup Language,";
! 540: $lpml .= ' by Scott Harrison 2001'."\n";
! 541: $lpml .= '# This file was automatically generated on '.`date`;
! 542: $lpml .= "\n".$invocation;
! 543: $lpml .= "SHELL=\"/bin/sh\"\n\n";
! 544: }
! 545: else {
! 546: return '';
! 547: }
! 548: }
! 549: # --------------------------------------------------- Format targetroot section
! 550: sub format_targetroot {
! 551: my $text=&trim($parser->get_text('/targetroot'));
! 552: $text=$targetroot if $targetroot;
! 553: $parser->get_tag('/targetroot');
! 554: if ($mode eq 'html') {
! 555: return $targetroot="\n<br />TARGETROOT: $text";
! 556: }
! 557: elsif ($mode eq 'install' or $mode eq 'build' or
! 558: $mode eq 'configinstall') {
! 559: return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
! 560: }
! 561: else {
! 562: return '';
! 563: }
! 564: }
! 565: # --------------------------------------------------- Format sourceroot section
! 566: sub format_sourceroot {
! 567: my $text=&trim($parser->get_text('/sourceroot'));
! 568: $text=$sourceroot if $sourceroot;
! 569: $parser->get_tag('/sourceroot');
! 570: if ($mode eq 'html') {
! 571: return $sourceroot="\n<br />SOURCEROOT: $text";
! 572: }
! 573: elsif ($mode eq 'install' or $mode eq 'build' or
! 574: $mode eq 'configinstall') {
! 575: return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
! 576: }
! 577: else {
! 578: return '';
! 579: }
! 580: }
! 581: # --------------------------------------------------- Format categories section
! 582: sub format_categories {
! 583: my $text=&trim($parser->get_text('/categories'));
! 584: $parser->get_tag('/categories');
! 585: if ($mode eq 'html') {
! 586: return $categories="\n<br /> <br />".
! 587: "\n<a name='ownperms'>".
! 588: "\n<font size='+2'>File Type Ownership and Permissions".
! 589: " Descriptions</font>".
! 590: "\n<p>This table shows what permissions and ownership settings ".
! 591: "correspond to each category.</p>".
! 592: "\n<table border='1' cellpadding='5' width='60%'>\n".
! 593: "<tr>".
! 594: "<th align='left' bgcolor='#ffffff'>Icon</th>".
! 595: "<th align='left' bgcolor='#ffffff'>Category Name</th>".
! 596: "<th align='left' bgcolor='#ffffff'>Permissions ".
! 597: "($categorytype)</th>".
! 598: "</tr>".
! 599: "\n$text\n".
! 600: "</table>\n";
! 601: }
! 602: elsif ($mode eq 'text') {
! 603: return $categories="\n".
! 604: "\nFile Type Ownership and Permissions".
! 605: " Descriptions".
! 606: "\n$text".
! 607: "\n";
! 608: }
! 609: else {
! 610: return '';
! 611: }
! 612: }
! 613: # --------------------------------------------------- Format categories section
! 614: sub format_category {
! 615: my (@tokeninfo)=@_;
! 616: $category_att_name=$tokeninfo[2]->{'name'};
! 617: $category_att_type=$tokeninfo[2]->{'type'};
! 618: $abbreviation=''; $chmod='';$chown='';
! 619: $parser->get_text('/category');
! 620: $parser->get_tag('/category');
! 621: $fab{$category_att_name}=$abbreviation;
! 622: if ($mode eq 'html') {
! 623: if ($category_att_type eq $categorytype) {
! 624: push @categorynamelist,$category_att_name;
! 625: $categoryhash{$category_att_name}="$chmod $chown";
! 626: return $category="<tr>".
! 627: "<td><img src='$abbreviation.gif' ".
! 628: "alt='${category_att_name}' /></td>\n".
! 629: "<td>${category_att_name}</td>\n".
! 630: "<td>$chmod $chown</td>\n".
! 631: "</tr>".
! 632: "\n";
! 633: # return $category="\n<br />CATEGORY $category_att_name ".
! 634: # "$category_att_type $chmod $chown";
! 635: }
! 636: }
! 637: else {
! 638: if ($category_att_type eq $categorytype) {
! 639: my ($user,$group)=split(/\:/,$chown);
! 640: $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
! 641: ' -m '.$chmod;
! 642: }
! 643: return '';
! 644: }
! 645: }
! 646: # --------------------------------------------------- Format categories section
! 647: sub format_abbreviation {
! 648: my @tokeninfo=@_;
! 649: $abbreviation='';
! 650: my $text=&trim($parser->get_text('/abbreviation'));
! 651: if ($text) {
! 652: $parser->get_tag('/abbreviation');
! 653: $abbreviation=$text;
! 654: }
! 655: return '';
! 656: }
! 657: # -------------------------------------------------------- Format chown section
! 658: sub format_chown {
! 659: my @tokeninfo=@_;
! 660: $chown='';
! 661: my $text=&trim($parser->get_text('/chown'));
! 662: if ($text) {
! 663: $parser->get_tag('/chown');
! 664: $chown=$text;
! 665: }
! 666: return '';
! 667: }
! 668: # -------------------------------------------------------- Format chmod section
! 669: sub format_chmod {
! 670: my @tokeninfo=@_;
! 671: $chmod='';
! 672: my $text=&trim($parser->get_text('/chmod'));
! 673: if ($text) {
! 674: $parser->get_tag('/chmod');
! 675: $chmod=$text;
! 676: }
! 677: return '';
! 678: }
! 679: # ---------------------------------------------------------- Format rpm section
! 680: sub format_rpm {
! 681: my $text=&trim($parser->get_text('/rpm'));
! 682: $parser->get_tag('/rpm');
! 683: if ($mode eq 'html') {
! 684: return $rpm=<<END;
! 685: <br /> <br />
! 686: <a name='package' />
! 687: <font size='+2'>Software Package Description</font>
! 688: <p>
! 689: <table bgcolor='#ffffff' border='0' cellpadding='10' cellspacing='0'>
! 690: <tr><td><pre>
! 691: $text
! 692: </pre></td></tr>
! 693: </table>
! 694: END
! 695: }
! 696: elsif ($mode eq 'make_rpm') {
! 697: return $text;
! 698: }
! 699: elsif ($mode eq 'text') {
! 700: return $rpm=<<END;
! 701: Software Package Description
! 702:
! 703: $text
! 704: END
! 705: }
! 706: else {
! 707: return '';
! 708: }
! 709: }
! 710: # --------------------------------------------------- Format rpmSummary section
! 711: sub format_rpmSummary {
! 712: my $text=&trim($parser->get_text('/rpmSummary'));
! 713: $parser->get_tag('/rpmSummary');
! 714: if ($mode eq 'html') {
! 715: return $rpmSummary="\nSummary : $text";
! 716: }
! 717: elsif ($mode eq 'text') {
! 718: return $rpmSummary="\nSummary : $text";
! 719: }
! 720: elsif ($mode eq 'make_rpm') {
! 721: return <<END;
! 722: <summary>$text</summary>
! 723: END
! 724: }
! 725: else {
! 726: return '';
! 727: }
! 728: }
! 729: # ------------------------------------------------------ Format rpmName section
! 730: sub format_rpmName {
! 731: my $text=&trim($parser->get_text('/rpmName'));
! 732: $parser->get_tag('/rpmName');
! 733: if ($mode eq 'html') {
! 734: return $rpmName="\nName : $text";
! 735: }
! 736: elsif ($mode eq 'text') {
! 737: return $rpmName="\nName : $text";
! 738: }
! 739: elsif ($mode eq 'make_rpm') {
! 740: return <<END;
! 741: <name>$text</name>
! 742: END
! 743: }
! 744: else {
! 745: return '';
! 746: }
! 747: }
! 748: # --------------------------------------------------- Format rpmVersion section
! 749: sub format_rpmVersion {
! 750: my $text=$parser->get_text('/rpmVersion');
! 751: $parser->get_tag('/rpmVersion');
! 752: if ($mode eq 'html') {
! 753: return $rpmVersion="\nVersion : $text";
! 754: }
! 755: elsif ($mode eq 'text') {
! 756: return $rpmVersion="\nVersion : $text";
! 757: }
! 758: else {
! 759: return '';
! 760: }
! 761: }
! 762: # --------------------------------------------------- Format rpmRelease section
! 763: sub format_rpmRelease {
! 764: my $text=$parser->get_text('/rpmRelease');
! 765: $parser->get_tag('/rpmRelease');
! 766: if ($mode eq 'html') {
! 767: return $rpmRelease="\nRelease : $text";
! 768: }
! 769: elsif ($mode eq 'text') {
! 770: return $rpmRelease="\nRelease : $text";
! 771: }
! 772: else {
! 773: return '';
! 774: }
! 775: }
! 776: # ---------------------------------------------------- Format rpmVendor section
! 777: sub format_rpmVendor {
! 778: my $text=$parser->get_text('/rpmVendor');
! 779: $parser->get_tag('/rpmVendor');
! 780: if ($mode eq 'html') {
! 781: return $rpmVendor="\nVendor : $text";
! 782: }
! 783: elsif ($mode eq 'text') {
! 784: return $rpmVendor="\nVendor : $text";
! 785: }
! 786: elsif ($mode eq 'make_rpm') {
! 787: return <<END;
! 788: <vendor>$text</vendor>
! 789: END
! 790: }
! 791: else {
! 792: return '';
! 793: }
! 794: }
! 795: # ------------------------------------------------- Format rpmBuildRoot section
! 796: sub format_rpmBuildRoot {
! 797: my $text=$parser->get_text('/rpmBuildRoot');
! 798: $parser->get_tag('/rpmBuildRoot');
! 799: if ($mode eq 'html') {
! 800: return $rpmBuildRoot="\nBuild Root : $text";
! 801: }
! 802: elsif ($mode eq 'text') {
! 803: return $rpmBuildRoot="\nBuild Root : $text";
! 804: }
! 805: else {
! 806: return '';
! 807: }
! 808: }
! 809: # ------------------------------------------------- Format rpmCopyright section
! 810: sub format_rpmCopyright {
! 811: my $text=$parser->get_text('/rpmCopyright');
! 812: $parser->get_tag('/rpmCopyright');
! 813: if ($mode eq 'html') {
! 814: return $rpmCopyright="\nLicense : $text";
! 815: }
! 816: elsif ($mode eq 'text') {
! 817: return $rpmCopyright="\nLicense : $text";
! 818: }
! 819: elsif ($mode eq 'make_rpm') {
! 820: return <<END;
! 821: <copyright>$text</copyright>
! 822: END
! 823: }
! 824: else {
! 825: return '';
! 826: }
! 827: }
! 828: # ----------------------------------------------------- Format rpmGroup section
! 829: sub format_rpmGroup {
! 830: my $text=$parser->get_text('/rpmGroup');
! 831: $parser->get_tag('/rpmGroup');
! 832: if ($mode eq 'html') {
! 833: return $rpmGroup="\nGroup : $text";
! 834: }
! 835: elsif ($mode eq 'text') {
! 836: return $rpmGroup="\nGroup : $text";
! 837: }
! 838: elsif ($mode eq 'make_rpm') {
! 839: return <<END;
! 840: <group>Utilities/System</group>
! 841: END
! 842: }
! 843: else {
! 844: return '';
! 845: }
! 846: }
! 847: # ---------------------------------------------------- Format rpmSource section
! 848: sub format_rpmSource {
! 849: my $text=$parser->get_text('/rpmSource');
! 850: $parser->get_tag('/rpmSource');
! 851: if ($mode eq 'html') {
! 852: return $rpmSource="\nSource : $text";
! 853: }
! 854: elsif ($mode eq 'text') {
! 855: return $rpmSource="\nSource : $text";
! 856: }
! 857: else {
! 858: return '';
! 859: }
! 860: }
! 861: # ----------------------------------------------- Format rpmAutoReqProv section
! 862: sub format_rpmAutoReqProv {
! 863: my $text=$parser->get_text('/rpmAutoReqProv');
! 864: $parser->get_tag('/rpmAutoReqProv');
! 865: if ($mode eq 'html') {
! 866: return $rpmAutoReqProv="\nAutoReqProv : $text";
! 867: }
! 868: elsif ($mode eq 'text') {
! 869: return $rpmAutoReqProv="\nAutoReqProv : $text";
! 870: }
! 871: elsif ($mode eq 'make_rpm') {
! 872: return <<END;
! 873: <AutoReqProv>$text</AutoReqProv>
! 874: END
! 875: }
! 876: else {
! 877: return '';
! 878: }
! 879: }
! 880: # ----------------------------------------------- Format rpmdescription section
! 881: sub format_rpmdescription {
! 882: my $text=$parser->get_text('/rpmdescription');
! 883: $parser->get_tag('/rpmdescription');
! 884: if ($mode eq 'html') {
! 885: $text=~s/\n//g;
! 886: $text=~s/\\n/\n/g;
! 887: return $rpmdescription="\nDescription : $text";
! 888: }
! 889: elsif ($mode eq 'text') {
! 890: $text=~s/\n//g;
! 891: $text=~s/\\n/\n/g;
! 892: return $rpmdescription="\nDescription : $text";
! 893: }
! 894: elsif ($mode eq 'make_rpm') {
! 895: $text=~s/\n//g;
! 896: $text=~s/\\n/\n/g;
! 897: return <<END;
! 898: <description>$text</description>
! 899: END
! 900: }
! 901: else {
! 902: return '';
! 903: }
! 904: }
! 905: # ------------------------------------------------------- Format rpmpre section
! 906: sub format_rpmpre {
! 907: my $text=$parser->get_text('/rpmpre');
! 908: $parser->get_tag('/rpmpre');
! 909: if ($mode eq 'html') {
! 910: # return $rpmpre="\n<br />RPMPRE $text";
! 911: return '';
! 912: }
! 913: elsif ($mode eq 'make_rpm') {
! 914: return <<END;
! 915: <pre>$text</pre>
! 916: END
! 917: }
! 918: else {
! 919: return '';
! 920: }
! 921: }
! 922: # -------------------------------------------------- Format requires section
! 923: sub format_rpmRequires {
! 924: my @tokeninfo=@_;
! 925: my $aref;
! 926: my $text;
! 927: if ($mode eq 'make_rpm') {
! 928: while ($aref=$parser->get_token()) {
! 929: if ($aref->[0] eq 'E' && $aref->[1] eq 'rpmRequires') {
! 930: last;
! 931: }
! 932: elsif ($aref->[0] eq 'S') {
! 933: $text.=$aref->[4];
! 934: }
! 935: elsif ($aref->[0] eq 'E') {
! 936: $text.=$aref->[2];
! 937: }
! 938: else {
! 939: $text.=$aref->[1];
! 940: }
! 941: }
! 942: }
! 943: else {
! 944: $parser->get_tag('/rpmRequires');
! 945: return '';
! 946: }
! 947: return '<rpmRequires>'.$text.'</rpmRequires>';
! 948: }
! 949: # -------------------------------------------------- Format directories section
! 950: sub format_directories {
! 951: my $text=$parser->get_text('/directories');
! 952: $parser->get_tag('/directories');
! 953: if ($mode eq 'html') {
! 954: $text=~s/\[\{\{\{\{\{DPATHLENGTH\}\}\}\}\}\]/$dpathlength/g;
! 955: return $directories="\n<br /> <br />".
! 956: "<a name='directories' />".
! 957: "<font size='+2'>Directory Structure</font>".
! 958: "\n<br /> <br />".
! 959: "<table border='1' cellpadding='3' cellspacing='0'>\n".
! 960: "<tr><th bgcolor='#ffffff'>Category</th>".
! 961: "<th bgcolor='#ffffff'>Status</th>\n".
! 962: "<th bgcolor='#ffffff'>Expected Permissions & Ownership</th>\n".
! 963: "<th bgcolor='#ffffff' colspan='$dpathlength'>Target Directory ".
! 964: "Path</th></tr>\n".
! 965: "\n$text\n</table><br />"."\n";
! 966: }
! 967: elsif ($mode eq 'text') {
! 968: return $directories="\nDirectory Structure\n$text\n".
! 969: "\n";
! 970: }
! 971: elsif ($mode eq 'install') {
! 972: return "\n".'directories:'."\n".$text;
! 973: }
! 974: elsif ($mode eq 'rpm_file_list') {
! 975: return $text;
! 976: }
! 977: else {
! 978: return '';
! 979: }
! 980: }
! 981: # ---------------------------------------------------- Format directory section
! 982: sub format_directory {
! 983: my (@tokeninfo)=@_;
! 984: $targetdir='';$categoryname='';$description='';
! 985: $parser->get_text('/directory');
! 986: $parser->get_tag('/directory');
! 987: $directory_count++;
! 988: $categorycount{$categoryname}++;
! 989: if ($mode eq 'html') {
! 990: my @a;
! 991: @a=($targetdir=~/\//g);
! 992: my $d=scalar(@a)+1;
! 993: $dpathlength=$d if $d>$dpathlength;
! 994: my $thtml=$targetdir;
! 995: $thtml=~s/\//\<\/td\>\<td bgcolor='#ffffff'\>/g;
! 996: my ($chmod,$chown)=split(/\s/,$categoryhash{$categoryname});
! 997: return $directory="\n<tr><td rowspan='2' bgcolor='#ffffff'>".
! 998: "$categoryname</td>".
! 999: "<td rowspan='2' bgcolor='#ffffff'><!-- POSTEVAL [$categoryname] ".
! 1000: "verify.pl directory /$targetdir $categoryhash{$categoryname} -->".
! 1001: " </td>".
! 1002: "<td rowspan='2' bgcolor='#ffffff'>$chmod<br />$chown</td>".
! 1003: "<td bgcolor='#ffffff'>$thtml</td></tr>".
! 1004: "<tr><td bgcolor='#ffffff' colspan='[{{{{{DPATHLENGTH}}}}}]'>".
! 1005: "$description</td></tr>";
! 1006: }
! 1007: if ($mode eq 'text') {
! 1008: return $directory="\nDIRECTORY $targetdir $categoryname ".
! 1009: "$description";
! 1010: }
! 1011: elsif ($mode eq 'install') {
! 1012: return "\t".'install '.$categoryhash{$categoryname}.' -d '.
! 1013: $targetroot.'/'.$targetdir."\n";
! 1014: }
! 1015: elsif ($mode eq 'rpm_file_list') {
! 1016: return $targetroot.'/'.$targetdir."\n";
! 1017: }
! 1018: else {
! 1019: return '';
! 1020: }
! 1021: }
! 1022: # ---------------------------------------------------- Format targetdir section
! 1023: sub format_targetdir {
! 1024: my @tokeninfo=@_;
! 1025: $targetdir='';
! 1026: my $text=&trim($parser->get_text('/targetdir'));
! 1027: if ($text) {
! 1028: $parser->get_tag('/targetdir');
! 1029: $targetdir=$text;
! 1030: }
! 1031: return '';
! 1032: }
! 1033: # ------------------------------------------------- Format categoryname section
! 1034: sub format_categoryname {
! 1035: my @tokeninfo=@_;
! 1036: $categoryname='';
! 1037: my $text=&trim($parser->get_text('/categoryname'));
! 1038: if ($text) {
! 1039: $parser->get_tag('/categoryname');
! 1040: $categoryname=$text;
! 1041: }
! 1042: return '';
! 1043: }
! 1044: # -------------------------------------------------- Format description section
! 1045: sub format_description {
! 1046: my @tokeninfo=@_;
! 1047: $description='';
! 1048: my $text=&htmlsafe(&trim($parser->get_text('/description')));
! 1049: if ($text) {
! 1050: $parser->get_tag('/description');
! 1051: $description=$text;
! 1052: }
! 1053: return '';
! 1054: }
! 1055: # -------------------------------------------------------- Format files section
! 1056: sub format_files {
! 1057: my $text=$parser->get_text('/files');
! 1058: $parser->get_tag('/files');
! 1059: if ($mode eq 'MANIFEST') {
! 1060: return $text;
! 1061: }
! 1062: elsif ($mode eq 'html') {
! 1063: return $directories="\n<br /> <br />".
! 1064: "<a name='files' />".
! 1065: "<font size='+2'>Files</font><br /> <br />".
! 1066: "<p>All source and target locations are relative to the ".
! 1067: "sourceroot and targetroot values at the beginning of this ".
! 1068: "document.</p>".
! 1069: "\n<table border='1' cellpadding='5'>".
! 1070: "<tr><th>Status</th><th colspan='2'>Category</th>".
! 1071: "<th>Name/Location</th>".
! 1072: "<th>Description</th><th>Notes</th></tr>".
! 1073: "$text</table>\n".
! 1074: "\n";
! 1075: }
! 1076: elsif ($mode eq 'text') {
! 1077: return $directories="\n".
! 1078: "File and Directory Structure".
! 1079: "\n$text\n".
! 1080: "\n";
! 1081: }
! 1082: elsif ($mode eq 'install') {
! 1083: return "\n".'files:'."\n".$text.
! 1084: "\n".'links:'."\n".join('',@links);
! 1085: }
! 1086: elsif ($mode eq 'configinstall') {
! 1087: return "\n".'configfiles: '.
! 1088: join(' ',@configall).
! 1089: "\n\n".$text.
! 1090: "\n\nalwaysrun:\n\n";
! 1091: }
! 1092: elsif ($mode eq 'build') {
! 1093: my $binfo;
! 1094: my $tword;
! 1095: my $command2;
! 1096: my @deps;
! 1097: foreach my $bi (@buildinfo) {
! 1098: my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi);
! 1099: $tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
! 1100: if ($command!~/\s/) {
! 1101: $command=~s/\/([^\/]*)$//;
! 1102: $command2="cd $command; sh ./$1;\\";
! 1103: }
! 1104: else {
! 1105: $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
! 1106: $command2="cd $command; sh ./$2;\\";
! 1107: }
! 1108: my $depstring;
! 1109: my $depstring2="\t\t\@echo '';\\\n";
! 1110: my $olddep;
! 1111: foreach my $dep (@deps) {
! 1112: unless ($olddep) {
! 1113: $olddep=$deps[$#deps];
! 1114: }
! 1115: $depstring.="\telif !(test -r $command/$dep);\\\n";
! 1116: $depstring.="\t\tthen echo ".
! 1117: "\"**** WARNING **** missing the file: ".
! 1118: "$command/$dep\"$logcmd;\\\n";
! 1119: $depstring.="\t\ttest -e $source || test -e $target || echo ".
! 1120: "'**** ERROR **** neither source=$source nor target=".
! 1121: "$target exist and they cannot be built'$logcmd;\\\n";
! 1122: $depstring.="\t\tmake -f Makefile.build ${source}___DEPS;\\\n";
! 1123: if ($olddep) {
! 1124: $depstring2.="\t\tECODE=0;\\\n";
! 1125: $depstring2.="\t\t! test -e $source && test -r $command/$olddep &&".
! 1126: " { 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";
! 1127: }
! 1128: $olddep=$dep;
! 1129: }
! 1130: $binfo.="$source: $tword\n".
! 1131: "\t\@if !(echo \"\");\\\n\t\tthen echo ".
! 1132: "\"**** WARNING **** Strange shell. ".
! 1133: "Check your path settings.\"$logcmd;\\\n".
! 1134: $depstring.
! 1135: "\telse \\\n\t\t$command2\n\tfi\n\n";
! 1136: $binfo.="${source}___DEPS:\n".$depstring2."\t\tECODE=0;\n\n";
! 1137: }
! 1138: return 'all: '.join(' ',@buildall)."\n\n".
! 1139: $text.
! 1140: $binfo."\n".
! 1141: "alwaysrun:\n\n";
! 1142: }
! 1143: elsif ($mode eq 'rpm_file_list') {
! 1144: return $text;
! 1145: }
! 1146: else {
! 1147: return '';
! 1148: }
! 1149: }
! 1150: # ---------------------------------------------------- Format fileglobs section
! 1151: sub format_fileglobs {
! 1152:
! 1153: }
! 1154: # -------------------------------------------------------- Format links section
! 1155: # deprecated.. currently <link></link>'s are included in <files></files>
! 1156: sub format_links {
! 1157: my $text=$parser->get_text('/links');
! 1158: $parser->get_tag('/links');
! 1159: if ($mode eq 'html') {
! 1160: return $links="\n<br />BEGIN LINKS\n$text\n<br />END LINKS\n";
! 1161: }
! 1162: elsif ($mode eq 'install') {
! 1163: return "\n".'links:'."\n\t".$text;
! 1164: }
! 1165: else {
! 1166: return '';
! 1167: }
! 1168: }
! 1169: # --------------------------------------------------------- Format file section
! 1170: sub format_file {
! 1171: my @tokeninfo=@_;
! 1172: $file=''; $source=''; $target=''; $categoryname=''; $description='';
! 1173: $note=''; $build=''; $status=''; $dependencies='';
! 1174: my $text=&trim($parser->get_text('/file'));
! 1175: my $buildtest;
! 1176: $file_count++;
! 1177: $categorycount{$categoryname}++;
! 1178: if ($source) {
! 1179: $parser->get_tag('/file');
! 1180: if ($mode eq 'MANIFEST') {
! 1181: my $command=$build;
! 1182: if ($command!~/\s/) {
! 1183: $command=~s/\/([^\/]*)$//;
! 1184: }
! 1185: else {
! 1186: $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
! 1187: }
! 1188: $command=~s/^$sourceroot\///;
! 1189: my (@deps)=split(/\;/,$dependencies);
! 1190: my $retval=join("\n",($source,
! 1191: (map {"$command$_"} @deps)));
! 1192: return $retval."\n";
! 1193: }
! 1194: elsif ($mode eq 'html') {
! 1195: return ($file="\n<!-- FILESORT:$target -->".
! 1196: "<tr>".
! 1197: "<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".
! 1198: "'$targetrootarg' ".
! 1199: "'$source' '$target' ".
! 1200: "$categoryhash{$categoryname} --> </td><td>".
! 1201: "<img src='$fab{$categoryname}.gif' ".
! 1202: "alt='$categoryname icon' /></td>".
! 1203: "<td>$categoryname<br /><font size='-1'>".
! 1204: $categoryhash{$categoryname}."</font></td>".
! 1205: "<td>SOURCE: $source<br />TARGET: $target</td>".
! 1206: "<td>$description</td>".
! 1207: "<td>$note</td>".
! 1208: "</tr>");
! 1209: # return ($file="\n<br />BEGIN FILE\n".
! 1210: # "$source $target $categoryname $description $note " .
! 1211: # "$build $status $dependencies" .
! 1212: # "\nEND FILE");
! 1213: }
! 1214: elsif ($mode eq 'install' && $categoryname ne 'conf') {
! 1215: if ($build) {
! 1216: my $bi=$sourceroot.'/'.$source.';'.$build.';'.
! 1217: $dependencies;
! 1218: my ($source2,$command,$trigger,@deps)=split(/\;/,$bi);
! 1219: $tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
! 1220: $command=~s/\/([^\/]*)$//;
! 1221: $command2="cd $command; sh ./$1;\\";
! 1222: my $depstring;
! 1223: foreach my $dep (@deps) {
! 1224: $depstring.=<<END;
! 1225: ECODE=0; DEP=''; \\
! 1226: test -e $dep || (echo '**** WARNING **** cannot evaluate status of dependency $dep (for building ${sourceroot}/${source} with)'$logcmd); DEP="1"; \\
! 1227: [ -n DEP ] && { perl filecompare.pl -b2 $dep ${targetroot}/${target} || ECODE=\$\$?; } || DEP="1"; \\
! 1228: case "\$\$ECODE" in \\
! 1229: 2) echo "**** WARNING **** dependency $dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\
! 1230: esac; \\
! 1231: END
! 1232: }
! 1233: chomp $depstring;
! 1234: $buildtest=<<END;
! 1235: \@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\
! 1236: echo "**** ERROR **** ${sourceroot}/${source} is missing and is also not present at target location ${targetroot}/${target}; you must run make build"$logcmd; exit; \\
! 1237: END
! 1238: $buildtest.=<<END if $depstring;
! 1239: elif !(test -e "${sourceroot}/${source}"); then \\
! 1240: $depstring
! 1241: END
! 1242: $buildtest.=<<END;
! 1243: fi
! 1244: END
! 1245: }
! 1246: my $bflag='-b1';
! 1247: $bflag='-b3' if $dependencies or $buildlink;
! 1248: return <<END;
! 1249: $buildtest \@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\
! 1250: echo "**** ERROR **** CVS source file does not exist: ${sourceroot}/${source} and neither does target: ${targetroot}/${target}"$logcmd; \\
! 1251: elif !(test -e "${sourceroot}/${source}"); then \\
! 1252: echo "**** WARNING **** CVS source file does not exist: ${sourceroot}/${source}"$logcmd; \\
! 1253: perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
! 1254: else \\
! 1255: ECODE=0; \\
! 1256: perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${target} || ECODE=\$\$?; \\
! 1257: case "\$\$ECODE" in \\
! 1258: 1) echo "${targetroot}/${target} is unchanged";; \\
! 1259: 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};; \\
! 1260: 0) echo "install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
! 1261: esac; \\
! 1262: perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
! 1263: fi
! 1264: END
! 1265: }
! 1266: elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
! 1267: push @configall,$targetroot.'/'.$target;
! 1268: return $targetroot.'/'.$target.': alwaysrun'."\n".
! 1269: "\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 '.
! 1270: $sourceroot.'/'.$source.' '.$targetroot.'/'.$target.
! 1271: ' || ECODE=$$?; } && '.
! 1272: '{ [ $$ECODE != "2" ] || (install '.
! 1273: $categoryhash{$categoryname}.' '.
! 1274: $sourceroot.'/'.$source.' '.
! 1275: $targetroot.'/'.$target.'.lpmlnew'.
! 1276: ' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'.
! 1277: $logcmd.' && echo "'.
! 1278: 'You likely need to compare contents of '.
! 1279: ''.$targetroot.'/'.$target.' with the new '.
! 1280: ''.$targetroot.'/'.$target.'.lpmlnew"'.
! 1281: "$logcmd); } && ".
! 1282: '{ [ $$ECODE != "3" ] || (install '.
! 1283: $categoryhash{$categoryname}.' '.
! 1284: $sourceroot.'/'.$source.' '.
! 1285: $targetroot.'/'.$target.''.
! 1286: ' && echo "**** WARNING: NEW CONFIGURATION FILE ADDED ****"'.
! 1287: $logcmd.' && echo "'.
! 1288: 'You likely need to review the contents of '.
! 1289: ''.$targetroot.'/'.$target.' to make sure its '.
! 1290: 'settings are compatible with your overall system"'.
! 1291: "$logcmd); } && ".
! 1292: '{ [ $$ECODE != "1" ] || ('.
! 1293: 'echo "**** ERROR ****"'.
! 1294: $logcmd.' && echo "'.
! 1295: 'Configuration source file does not exist '.
! 1296: ''.$sourceroot.'/'.$source.'"'.
! 1297: "$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"".
! 1298: "$categoryhash{$categoryname}\"$logcmd;\n\n";
! 1299: }
! 1300: elsif ($mode eq 'build' && $build) {
! 1301: push @buildall,$sourceroot.'/'.$source;
! 1302: push @buildinfo,$targetroot.'/'.$target.';'.$sourceroot.'/'.
! 1303: $source.';'.$build.';'.
! 1304: $dependencies;
! 1305: # return '# need to build '.$source.";
! 1306: }
! 1307: elsif ($mode eq 'rpm_file_list') {
! 1308: if ($categoryname eq 'doc') {
! 1309: return $targetroot.'/'.$target.' # doc'."\n";
! 1310: }
! 1311: elsif ($categoryname eq 'conf') {
! 1312: return $targetroot.'/'.$target.' # config'."\n";
! 1313: }
! 1314: else {
! 1315: return $targetroot.'/'.$target."\n";
! 1316: }
! 1317: }
! 1318: else {
! 1319: return '';
! 1320: }
! 1321: }
! 1322: return '';
! 1323: }
! 1324: # --------------------------------------------------------- Format link section
! 1325: sub format_link {
! 1326: my @tokeninfo=@_;
! 1327: $link=''; $linkto=''; $source=''; $target=''; $categoryname='';
! 1328: $description=''; $note=''; $build=''; $status=''; $dependencies='';
! 1329: my $text=&trim($parser->get_text('/link'));
! 1330: if ($linkto) {
! 1331: $parser->get_tag('/link');
! 1332: if ($mode eq 'html') {
! 1333: my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
! 1334: $link_count+=scalar(@targets);
! 1335: foreach my $tgt (@targets) {
! 1336: $categorycount{$categoryname}++;
! 1337: push @links,("\n<!-- FILESORT:$tgt -->".
! 1338: "<tr>".
! 1339: "<td><!-- POSTEVAL [$categoryname] verify.pl link ".
! 1340: "'/$targetrootarg$linkto' '/$targetrootarg$tgt' ".
! 1341: "$categoryhash{$categoryname} --> </td><td>".
! 1342: "<img src='$fab{$categoryname}.gif' ".
! 1343: "alt='$categoryname icon' /></td>".
! 1344: "<td><font size='-1'>$categoryname</font></td>".
! 1345: "<td>LINKTO: $linkto<br />TARGET: $tgt</td>".
! 1346: "<td>$description</td>".
! 1347: "<td>$note</td>".
! 1348: "</tr>");
! 1349: # push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt.
! 1350: # "\n";
! 1351: }
! 1352: return join('',@links);
! 1353: # return ($link="\n<!-- FILESORT:$target -->".
! 1354: # "<tr>".
! 1355: # "<td> </td><td><img src='$fab{$categoryname}.gif' ".
! 1356: # "alt='$categoryname icon' /></td>".
! 1357: # "<td>$categoryname</td>".
! 1358: # "<td>LINKTO: $linkto<br />TARGET: $target</td>".
! 1359: # "<td>$description</td>".
! 1360: # "<td>$note</td>".
! 1361: # "</tr>");
! 1362: # return $link="\n<tr><td colspan='6'>BEGIN LINK\n".
! 1363: # "$linkto $target $categoryname $description $note " .
! 1364: # "$build $status $dependencies" .
! 1365: # "\nEND LINK</td></tr>";
! 1366: }
! 1367: elsif ($mode eq 'install') {
! 1368: my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
! 1369: foreach my $tgt (@targets) {
! 1370: push @links,"\t".'ln -fs /'.$linkto.' '.$targetroot.'/'.$tgt.
! 1371: "\n";
! 1372: }
! 1373: # return join('',@links);
! 1374: return '';
! 1375: }
! 1376: elsif ($mode eq 'rpm_file_list') {
! 1377: my @linklocs;
! 1378: my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
! 1379: foreach my $tgt (@targets) {
! 1380: push @linklocs,''.$targetroot.'/'.$tgt."\n";
! 1381: }
! 1382: return join('',@linklocs);
! 1383: }
! 1384: else {
! 1385: return '';
! 1386: }
! 1387: }
! 1388: return '';
! 1389: }
! 1390: # ----------------------------------------------------- Format fileglob section
! 1391: sub format_fileglob {
! 1392: my @tokeninfo=@_;
! 1393: $fileglob=''; $glob=''; $sourcedir='';
! 1394: $targetdir=''; $categoryname=''; $description='';
! 1395: $note=''; $build=''; $status=''; $dependencies='';
! 1396: $filenames='';
! 1397: my $text=&trim($parser->get_text('/fileglob'));
! 1398: my $filenames2=$filenames;$filenames2=~s/\s//g;
! 1399: $fileglob_count++;
! 1400: my @semi=($filenames2=~/(\;)/g);
! 1401: $fileglobnames_count+=scalar(@semi)+1;
! 1402: $categorycount{$categoryname}+=scalar(@semi)+1;
! 1403: if ($sourcedir) {
! 1404: $parser->get_tag('/fileglob');
! 1405: if ($mode eq 'MANIFEST') {
! 1406: return join("\n",(map {"$sourcedir$_"} split(/\;/,$filenames2)))."\n";
! 1407: }
! 1408: elsif ($mode eq 'html') {
! 1409: return $fileglob="\n<tr>".
! 1410: "<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
! 1411: "'$targetrootarg' ".
! 1412: "'$glob' '$sourcedir' '$filenames2' '$targetdir' ".
! 1413: "$categoryhash{$categoryname} --> </td>".
! 1414: "<td>"."<img src='$fab{$categoryname}.gif' ".
! 1415: "alt='$categoryname icon' /></td>".
! 1416: "<td>$categoryname<br />".
! 1417: "<font size='-1'>".$categoryhash{$categoryname}."</font></td>".
! 1418: "<td>SOURCEDIR: $sourcedir<br />".
! 1419: "TARGETDIR: $targetdir<br />".
! 1420: "GLOB: $glob<br />".
! 1421: "FILENAMES: $filenames".
! 1422: "</td>".
! 1423: "<td>$description</td>".
! 1424: "<td>$note</td>".
! 1425: "</tr>";
! 1426: # return $fileglob="\n<tr><td colspan='6'>BEGIN FILEGLOB\n".
! 1427: # "$glob sourcedir $targetdir $categoryname $description $note ".
! 1428: # "$build $status $dependencies $filenames" .
! 1429: # "\nEND FILEGLOB</td></tr>";
! 1430: }
! 1431: elsif ($mode eq 'install') {
! 1432: my $eglob=$glob;
! 1433: if ($glob eq '*') {
! 1434: $eglob='[^C][^V][^S]'.$glob;
! 1435: }
! 1436: return "\t".'install '.
! 1437: $categoryhash{$categoryname}.' '.
! 1438: $sourceroot.'/'.$sourcedir.$eglob.' '.
! 1439: $targetroot.'/'.$targetdir.'.'."\n";
! 1440: }
! 1441: elsif ($mode eq 'rpm_file_list') {
! 1442: my $eglob=$glob;
! 1443: if ($glob eq '*') {
! 1444: $eglob='[^C][^V][^S]'.$glob;
! 1445: }
! 1446: my $targetdir2=$targetdir;$targetdir2=~s/\/$//;
! 1447: my @gfiles=map {s/^.*\///;"$targetroot/$targetdir2/$_\n"}
! 1448: glob("$sourceroot/$sourcedir/$eglob");
! 1449: return join('',@gfiles);
! 1450: }
! 1451: else {
! 1452: return '';
! 1453: }
! 1454: }
! 1455: return '';
! 1456: }
! 1457: # ---------------------------------------------------- Format sourcedir section
! 1458: sub format_sourcedir {
! 1459: my @tokeninfo=@_;
! 1460: $sourcedir='';
! 1461: my $text=&trim($parser->get_text('/sourcedir'));
! 1462: if ($text) {
! 1463: $parser->get_tag('/sourcedir');
! 1464: $sourcedir=$text;
! 1465: }
! 1466: return '';
! 1467: }
! 1468: # ------------------------------------------------------- Format target section
! 1469: sub format_target {
! 1470: my @tokeninfo=@_;
! 1471: $target='';
! 1472: my $text=&trim($parser->get_text('/target'));
! 1473: if ($text) {
! 1474: $parser->get_tag('/target');
! 1475: $target=$text;
! 1476: }
! 1477: return '';
! 1478: }
! 1479: # ------------------------------------------------------- Format source section
! 1480: sub format_source {
! 1481: my @tokeninfo=@_;
! 1482: $source='';
! 1483: my $text=&trim($parser->get_text('/source'));
! 1484: if ($text) {
! 1485: $parser->get_tag('/source');
! 1486: $source=$text;
! 1487: }
! 1488: return '';
! 1489: }
! 1490: # --------------------------------------------------------- Format note section
! 1491: sub format_note {
! 1492: my @tokeninfo=@_;
! 1493: $note='';
! 1494: # my $text=&trim($parser->get_text('/note'));
! 1495: my $aref;
! 1496: my $text;
! 1497: while ($aref=$parser->get_token()) {
! 1498: if ($aref->[0] eq 'E' && $aref->[1] eq 'note') {
! 1499: last;
! 1500: }
! 1501: elsif ($aref->[0] eq 'S') {
! 1502: $text.=$aref->[4];
! 1503: }
! 1504: elsif ($aref->[0] eq 'E') {
! 1505: $text.=$aref->[2];
! 1506: }
! 1507: else {
! 1508: $text.=$aref->[1];
! 1509: }
! 1510: }
! 1511: if ($text) {
! 1512: # $parser->get_tag('/note');
! 1513: $note=$text;
! 1514: }
! 1515: return '';
! 1516:
! 1517: }
! 1518: # -------------------------------------------------------- Format build section
! 1519: sub format_build {
! 1520: my @tokeninfo=@_;
! 1521: $build='';
! 1522: my $text=&trim($parser->get_text('/build'));
! 1523: if ($text) {
! 1524: $parser->get_tag('/build');
! 1525: $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
! 1526: $build=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines
! 1527: }
! 1528: return '';
! 1529: }
! 1530: # -------------------------------------------------------- Format build section
! 1531: sub format_buildlink {
! 1532: my @tokeninfo=@_;
! 1533: $buildlink='';
! 1534: my $text=&trim($parser->get_text('/buildlink'));
! 1535: if ($text) {
! 1536: $parser->get_tag('/buildlink');
! 1537: $buildlink=$sourceroot.'/'.$text;
! 1538: }
! 1539: return '';
! 1540: }
! 1541: # ------------------------------------------------------- Format status section
! 1542: sub format_status {
! 1543: my @tokeninfo=@_;
! 1544: $status='';
! 1545: my $text=&trim($parser->get_text('/status'));
! 1546: if ($text) {
! 1547: $parser->get_tag('/status');
! 1548: $status=$text;
! 1549: }
! 1550: return '';
! 1551: }
! 1552: # ------------------------------------------------- Format dependencies section
! 1553: sub format_dependencies {
! 1554: my @tokeninfo=@_;
! 1555: $dependencies='';
! 1556: my $text=&trim($parser->get_text('/dependencies'));
! 1557: if ($text) {
! 1558: $parser->get_tag('/dependencies');
! 1559: $dependencies=join(';',
! 1560: (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
! 1561: }
! 1562: return '';
! 1563: }
! 1564: # --------------------------------------------------------- Format glob section
! 1565: sub format_glob {
! 1566: my @tokeninfo=@_;
! 1567: $glob='';
! 1568: my $text=&trim($parser->get_text('/glob'));
! 1569: if ($text) {
! 1570: $parser->get_tag('/glob');
! 1571: $glob=$text;
! 1572: }
! 1573: return '';
! 1574: }
! 1575: # ---------------------------------------------------- Format filenames section
! 1576: sub format_filenames {
! 1577: my @tokeninfo=@_;
! 1578: my $text=&trim($parser->get_text('/filenames'));
! 1579: if ($text) {
! 1580: $parser->get_tag('/filenames');
! 1581: $filenames=$text;
! 1582: }
! 1583: return '';
! 1584: }
! 1585: # ----------------------------------------------- Format specialnotices section
! 1586: sub format_specialnotices {
! 1587: $parser->get_tag('/specialnotices');
! 1588: return '';
! 1589: }
! 1590: # ------------------------------------------------ Format specialnotice section
! 1591: sub format_specialnotice {
! 1592: $parser->get_tag('/specialnotice');
! 1593: return '';
! 1594: }
! 1595: # ------------------------------------------------------- Format linkto section
! 1596: sub format_linkto {
! 1597: my @tokeninfo=@_;
! 1598: my $text=&trim($parser->get_text('/linkto'));
! 1599: if ($text) {
! 1600: $parser->get_tag('/linkto');
! 1601: $linkto=$text;
! 1602: }
! 1603: return '';
! 1604: }
! 1605: # ------------------------------------- Render less-than and greater-than signs
! 1606: sub htmlsafe {
! 1607: my $text=@_[0];
! 1608: $text =~ s/</</g;
! 1609: $text =~ s/>/>/g;
! 1610: return $text;
! 1611: }
! 1612: # --------------------------------------- remove starting and ending whitespace
! 1613: sub trim {
! 1614: my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
! 1615: }
! 1616:
! 1617: # ----------------------------------- POD (plain old documentation, CPAN style)
! 1618:
! 1619: =pod
! 1620:
! 1621: =head1 NAME
! 1622:
! 1623: lpml_parse.pl - This is meant to parse files meeting the lpml document type.
! 1624:
! 1625: =head1 SYNOPSIS
! 1626:
! 1627: <STDIN> | perl lpml_parse.pl <MODE> <CATEGORY> <DIST> <SOURCE> <TARGET>
! 1628:
! 1629: Usage is for the lpml file to come in through standard input.
! 1630:
! 1631: =over 4
! 1632:
! 1633: =item *
! 1634:
! 1635: 1st argument is the mode of parsing.
! 1636:
! 1637: =item *
! 1638:
! 1639: 2nd argument is the category permissions to use (runtime or development)
! 1640:
! 1641: =item *
! 1642:
! 1643: 3rd argument is the distribution
! 1644: (default,redhat6.2,debian2.2,redhat7.1,etc).
! 1645:
! 1646: =item *
! 1647:
! 1648: 4th argument is to manually specify a sourceroot.
! 1649:
! 1650: =item *
! 1651:
! 1652: 5th argument is to manually specify a targetroot.
! 1653:
! 1654: =back
! 1655:
! 1656: Only the 1st argument is mandatory for the program to run.
! 1657:
! 1658: Example:
! 1659:
! 1660: cat ../../doc/loncapafiles.lpml |\\
! 1661: perl lpml_parse.pl html runtime default /home/sherbert/loncapa /tmp/install
! 1662:
! 1663: =head1 DESCRIPTION
! 1664:
! 1665: The general flow of the script is to get command line arguments, run through
! 1666: the XML document three times, and output according to any desired mode:
! 1667: install, configinstall, build, rpm, dpkg, htmldoc, textdoc, and status.
! 1668:
! 1669: A number of coding decisions are made according to the following principle:
! 1670: installation software must be stand-alone. Therefore, for instance, I try
! 1671: not to use the GetOpt::Long module or any other perl modules. (I do however
! 1672: use HTML::TokeParser.) I also have tried to keep all the MODES of
! 1673: parsing inside this file. Therefore, format_TAG subroutines are fairly
! 1674: lengthy with their conditional logic. A more "elegant" solution might
! 1675: be to dynamically register the parsing mode and subroutines, or maybe even work
! 1676: with stylesheets. However, in order to make this the installation back-bone
! 1677: of choice, there are advantages for HAVING EVERYTHING IN ONE FILE.
! 1678: This way, the LPML installation software does not have to rely on OTHER
! 1679: installation software (a chicken versus the egg problem). Besides, I would
! 1680: suggest the modes of parsing are fairly constant: install, configinstall,
! 1681: build, rpm, dpkg, htmldoc, textdoc, and status.
! 1682:
! 1683: Another coding decision is about using a multiple pass-through approach to
! 1684: parsing the lpml file. This saves memory and makes sure the server will never
! 1685: be overloaded. During the first pass-through, the script gathers information
! 1686: specific as to resolving what tags with what 'dist=' attributes are to be used.
! 1687: During the second pass-through, the script cleans up white-space surrounding
! 1688: the XML tags, and filters through the tags based on information regarding the
! 1689: 'dist=' attributes (information gathered in the first pass-through).
! 1690: The third and final pass-through involves formatting and rendering the XML
! 1691: into whatever XML mode is chosen: install, configinstall, build, rpm, dpkg,
! 1692: htmldoc, textdoc, and status.
! 1693:
! 1694: The hierarchy mandated by the DTD does not always correspond to the hierarchy
! 1695: that is sensible for a Makefile. For instance, in a Makefile it is sensible
! 1696: that soft-links are installed after files. However, in an LPML document, it
! 1697: is sensible that files and links be considered together and the writer of the
! 1698: LPML document should be free to place things in whatever order makes best
! 1699: sense in terms of LOOKING at the information. The complication that arises
! 1700: is that the parser needs to have a memory for passing values from
! 1701: leaves on the XML tree to higher-up branches. Currently, this memory is
! 1702: hard-coded (like with the @links array), but it may benefit from a more
! 1703: formal approach in the future.
! 1704:
! 1705: =head1 README
! 1706:
! 1707: This parses an LPML file to generate information useful for
! 1708: source to target installation, compilation, filesystem status
! 1709: checking, RPM and Debian software packaging, and documentation.
! 1710:
! 1711: More information on LPML is available at http://lpml.sourceforge.net.
! 1712:
! 1713: =head1 PREREQUISITES
! 1714:
! 1715: HTML::TokeParser
! 1716:
! 1717: =head1 COREQUISITES
! 1718:
! 1719: =head1 OSNAMES
! 1720:
! 1721: linux
! 1722:
! 1723: =head1 SCRIPT CATEGORIES
! 1724:
! 1725: UNIX/System_administration
! 1726:
! 1727: =head1 AUTHOR
! 1728:
! 1729: Scott Harrison
! 1730: codeharrison@yahoo.com
! 1731:
! 1732: Please let me know how/if you are finding this script useful and
! 1733: any/all suggestions. -Scott
! 1734:
! 1735: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lpml_parse.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / nsdl / build