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