1: #!/usr/bin/perl
2:
3: # The LearningOnline Network with CAPA
4: # piml_parse.pl - Linux Packaging Markup Language parser
5: #
6: # $Id: piml_parse.pl,v 1.1 2002/01/29 10:43:02 harris41 Exp $
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