1: #!/usr/bin/perl
2:
3: # Scott Harrison
4: # YEAR=2001
5: # May 2001
6: # 06/19/2001,06/20,06/24 - Scott Harrison
7: # 9/5/2001,9/6,9/7,9/8 - Scott Harrison
8: # 9/17,9/18 - Scott Harrison
9: # 11/4,11/5,11/6,11/7,11/16,11/17 - Scott Harrison
10: #
11: # $Id: lpml_parse.pl,v 1.23 2001/11/29 15:01:04 harris41 Exp $
12: ###
13:
14: ###############################################################################
15: ## ##
16: ## ORGANIZATION OF THIS PERL SCRIPT ##
17: ## 1. Notes ##
18: ## 2. Get command line arguments ##
19: ## 3. First pass through (grab distribution-specific information) ##
20: ## 4. Second pass through (parse out what is not necessary) ##
21: ## 5. Third pass through (translate markup according to specified mode) ##
22: ## 6. Functions (most all just format contents of different markup tags) ##
23: ## 7. POD (plain old documentation, CPAN style) ##
24: ## ##
25: ###############################################################################
26:
27: # ----------------------------------------------------------------------- Notes
28: #
29: # I am using a multiple pass-through approach to parsing
30: # the lpml file. This saves memory and makes sure the server
31: # will never be overloaded.
32: #
33: # This is meant to parse files meeting the lpml document type.
34: # See lpml.dtd. LPML=Linux Packaging Markup Language.
35:
36: use HTML::TokeParser;
37:
38: my $usage=<<END;
39: **** ERROR ERROR ERROR ERROR ****
40: Usage is for lpml file to come in through standard input.
41: 1st argument is the mode of parsing.
42: 2nd argument is the category permissions to use (runtime or development)
43: 3rd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).
44: 4th argument is to manually specify a sourceroot.
45: 5th argument is to manually specify a targetroot.
46:
47: Only the 1st argument is mandatory for the program to run.
48:
49: Example:
50:
51: cat ../../doc/loncapafiles.lpml |\\
52: perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install
53: END
54:
55: # ------------------------------------------------- Grab command line arguments
56:
57: my $mode;
58: if (@ARGV==5) {
59: $mode = shift @ARGV;
60: }
61: else {
62: @ARGV=();shift @ARGV;
63: while(<>){} # throw away the input to avoid broken pipes
64: print $usage;
65: exit -1; # exit with error status
66: }
67:
68: my $categorytype;
69: if (@ARGV) {
70: $categorytype = shift @ARGV;
71: }
72:
73: my $dist;
74: if (@ARGV) {
75: $dist = shift @ARGV;
76: }
77:
78: my $targetroot;
79: my $sourceroot;
80: if (@ARGV) {
81: $sourceroot = shift @ARGV;
82: }
83: if (@ARGV) {
84: $targetroot = shift @ARGV;
85: }
86: $sourceroot=~s/\/$//;
87: $targetroot=~s/\/$//;
88:
89: my $logcmd='| tee -a WARNINGS';
90:
91: my $invocation;
92: # --------------------------------------------------- Record program invocation
93: if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
94: $invocation=(<<END);
95: # Invocation: STDINPUT | lpml_parse.pl
96: # 1st argument (mode) is: $mode
97: # 2nd argument (category type) is: $categorytype
98: # 3rd argument (distribution) is: $dist
99: # 4th argument (targetroot) is: described below
100: # 5th argument (sourceroot) is: described below
101: END
102: }
103:
104: # ---------------------------------------------------- Start first pass through
105: my @parsecontents = <>;
106: my $parsestring = join('',@parsecontents);
107: my $outstring;
108:
109: # Need to make a pass through and figure out what defaults are
110: # overrided. Top-down overriding strategy (leaves don't know
111: # about distant leaves).
112:
113: my @hierarchy;
114: $hierarchy[0]=0;
115: my $hloc=0;
116: my $token;
117: $parser = HTML::TokeParser->new(\$parsestring) or
118: die('can\'t create TokeParser object');
119: $parser->xml_mode('1');
120: my %hash;
121: my $key;
122: while ($token = $parser->get_token()) {
123: if ($token->[0] eq 'S') {
124: $hloc++;
125: $hierarchy[$hloc]++;
126: $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
127: my $thisdist=' '.$token->[2]{'dist'}.' ';
128: if ($thisdist eq ' default ') {
129: $hash{$key}=1; # there is a default setting for this key
130: }
131: elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {
132: $hash{$key}=2; # disregard default setting for this key if
133: # there is a directly requested distribution match
134: }
135: }
136: if ($token->[0] eq 'E') {
137: $hloc--;
138: }
139: }
140:
141: # --------------------------------------------------- Start second pass through
142: undef $hloc;
143: undef @hierarchy;
144: undef $parser;
145: $hierarchy[0]=0;
146: $parser = HTML::TokeParser->new(\$parsestring) or
147: die('can\'t create TokeParser object');
148: $parser->xml_mode('1');
149: my $cleanstring;
150: while ($token = $parser->get_token()) {
151: if ($token->[0] eq 'S') {
152: $hloc++;
153: $hierarchy[$hloc]++;
154: $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
155: my $thisdist=' '.$token->[2]{'dist'}.' ';
156: # This conditional clause is set up to ignore two sets
157: # of invalid conditions before accepting entry into
158: # the cleanstring.
159: if ($hash{$key}==2 and
160: !($thisdist eq ' ' or $thisdist =~/\s$dist\s/)) {
161: if ($token->[4]!~/\/>$/) {
162: $parser->get_tag('/'.$token->[1]);
163: $hloc--;
164: }
165: }
166: elsif ($thisdist ne ' ' and $thisdist!~/\s$dist\s/ and
167: !($thisdist eq ' default ' and $hash{$key}!=2)) {
168: if ($token->[4]!~/\/>$/) {
169: $parser->get_tag('/'.$token->[1]);
170: $hloc--;
171: }
172: }
173: else {
174: $cleanstring.=$token->[4];
175: }
176: if ($token->[4]=~/\/>$/) {
177: $hloc--;
178: }
179: }
180: if ($token->[0] eq 'E') {
181: $cleanstring.=$token->[2];
182: $hloc--;
183: }
184: if ($token->[0] eq 'T') {
185: $cleanstring.=$token->[1];
186: }
187: }
188: $cleanstring=&trim($cleanstring);
189: $cleanstring=~s/\>\s*\n\s*\</\>\</g;
190:
191: # ---------------------------------------------------- Start final pass through
192:
193: # storage variables
194: my $lpml;
195: my $categories;
196: my $category;
197: my $category_att_name;
198: my $category_att_type;
199: my $chown;
200: my $chmod;
201: my $rpm;
202: my $rpmSummary;
203: my $rpmName;
204: my $rpmVersion;
205: my $rpmRelease;
206: my $rpmVendor;
207: my $rpmBuildRoot;
208: my $rpmCopyright;
209: my $rpmGroup;
210: my $rpmSource;
211: my $rpmAutoReqProv;
212: my $rpmdescription;
213: my $rpmpre;
214: my $directories;
215: my $directory;
216: my $targetdirs;
217: my $targetdir;
218: my $categoryname;
219: my $description;
220: my $files;
221: my $fileglobs;
222: my $links;
223: my $file;
224: my $link;
225: my $fileglob;
226: my $sourcedir;
227: my $targets;
228: my $target;
229: my $source;
230: my $note;
231: my $build;
232: my $buildlink;
233: my $commands;
234: my $command;
235: my $status;
236: my $dependencies;
237: my $dependency;
238: my @links;
239: my %categoryhash;
240:
241: my @buildall;
242: my @buildinfo;
243:
244: my @configall;
245:
246: # Make new parser with distribution specific input
247: undef $parser;
248: $parser = HTML::TokeParser->new(\$cleanstring) or
249: die('can\'t create TokeParser object');
250: $parser->xml_mode('1');
251:
252: # Define handling methods for mode-dependent text rendering
253: $parser->{textify}={
254: targetroot => \&format_targetroot,
255: sourceroot => \&format_sourceroot,
256: categories => \&format_categories,
257: category => \&format_category,
258: targetdir => \&format_targetdir,
259: chown => \&format_chown,
260: chmod => \&format_chmod,
261: rpm => \&format_rpm,
262: rpmSummary => \&format_rpmSummary,
263: rpmName => \&format_rpmName,
264: rpmVersion => \&format_rpmVersion,
265: rpmRelease => \&format_rpmRelease,
266: rpmVendor => \&format_rpmVendor,
267: rpmBuildRoot => \&format_rpmBuildRoot,
268: rpmCopyright => \&format_rpmCopyright,
269: rpmGroup => \&format_rpmGroup,
270: rpmSource => \&format_rpmSource,
271: rpmAutoReqProv => \&format_rpmAutoReqProv,
272: rpmdescription => \&format_rpmdescription,
273: rpmpre => \&format_rpmpre,
274: directories => \&format_directories,
275: directory => \&format_directory,
276: categoryname => \&format_categoryname,
277: description => \&format_description,
278: files => \&format_files,
279: file => \&format_file,
280: fileglob => \&format_fileglob,
281: links => \&format_links,
282: link => \&format_link,
283: linkto => \&format_linkto,
284: source => \&format_source,
285: target => \&format_target,
286: note => \&format_note,
287: build => \&format_build,
288: status => \&format_status,
289: dependencies => \&format_dependencies,
290: buildlink => \&format_buildlink,
291: glob => \&format_glob,
292: sourcedir => \&format_sourcedir,
293: filenames => \&format_filenames,
294: };
295:
296: my $text;
297: my $token;
298: undef $hloc;
299: undef @hierarchy;
300: my $hloc;
301: my @hierarchy2;
302: while ($token = $parser->get_tag('lpml')) {
303: &format_lpml(@{$token});
304: $text = &trim($parser->get_text('/lpml'));
305: $token = $parser->get_tag('/lpml');
306: print $lpml;
307: print "\n";
308: # $text=~s/\s*\n\s*\n\s*/\n/g;
309: print $text;
310: print "\n";
311: print &end();
312: }
313: exit;
314:
315: # ---------- Functions (most all just format contents of different markup tags)
316:
317: # ------------------------ Final output at end of markup parsing and formatting
318: sub end {
319: if ($mode eq 'html') {
320: return "<br />THE END\n";
321: }
322: if ($mode eq 'install') {
323: return '';
324: }
325: }
326:
327: # ----------------------- Take in string to parse and the separation expression
328: sub extract_array {
329: my ($stringtoparse,$sepexp) = @_;
330: my @a=split(/$sepexp/,$stringtoparse);
331: return \@a;
332: }
333:
334: # --------------------------------------------------------- Format lpml section
335: sub format_lpml {
336: my (@tokeninfo)=@_;
337: my $date=`date`; chop $date;
338: if ($mode eq 'html') {
339: $lpml = "<br /><font size='+2'>LPML Description Page (dist=$dist, ".
340: "$date)".
341: "</font>";
342: $lpml .=<<END;
343: <ul>
344: <li>About this file</li>
345: <li>Software Package Description</li>
346: <li>Directory Structure</li>
347: <li>File Type Ownership and Permissions</li>
348: <li>File and Directory Structure</li>
349: </ul>
350: END
351: $lpml .=<<END;
352: <font size='+2'>About this file</font>
353: <p>
354: This file is generated dynamically by <tt>lpml_parse.pl</tt> as
355: part of a development compilation process. Author: Scott
356: Harrison (harris41\@msu.edu).
357: </p>
358: END
359: }
360: elsif ($mode eq 'text') {
361: $lpml = "LPML Description Page (dist=$dist, $date)";
362: $lpml .=<<END;
363:
364: * About this file
365: * Software Package Description
366: * Directory Structure
367: * File Type Ownership and Permissions
368: * File and Directory Structure
369: END
370: $lpml .=<<END;
371:
372: About this file
373:
374: This file is generated dynamically by lpml_parse.pl as
375: part of a development compilation process. Author: Scott
376: Harrison (harris41\@msu.edu).
377:
378: END
379: }
380: elsif ($mode eq 'install') {
381: print '# LPML install targets. Linux Packaging Markup Language,';
382: print ' by Scott Harrison 2001'."\n";
383: print '# This file was automatically generated on '.`date`;
384: print "\n".$invocation;
385: $lpml .= "SHELL=\"/bin/bash\"\n\n";
386: }
387: elsif ($mode eq 'configinstall') {
388: print '# LPML configuration file targets (configinstall).'."\n";
389: print '# Linux Packaging Markup Language,';
390: print ' by Scott Harrison 2001'."\n";
391: print '# This file was automatically generated on '.`date`;
392: print "\n".$invocation;
393: $lpml .= "SHELL=\"/bin/bash\"\n\n";
394: }
395: elsif ($mode eq 'build') {
396: $lpml = "# LPML build targets. Linux Packaging Markup Language,";
397: $lpml .= ' by Scott Harrison 2001'."\n";
398: $lpml .= '# This file was automatically generated on '.`date`;
399: $lpml .= "\n".$invocation;
400: $lpml .= "SHELL=\"/bin/sh\"\n\n";
401: }
402: else {
403: return '';
404: }
405: }
406: # --------------------------------------------------- Format targetroot section
407: sub format_targetroot {
408: my $text=&trim($parser->get_text('/targetroot'));
409: $text=$targetroot if $targetroot;
410: $parser->get_tag('/targetroot');
411: if ($mode eq 'html') {
412: return $targetroot="\n<br />TARGETROOT: $text";
413: }
414: elsif ($mode eq 'install' or $mode eq 'build' or
415: $mode eq 'configinstall') {
416: return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
417: }
418: else {
419: return '';
420: }
421: }
422: # --------------------------------------------------- Format sourceroot section
423: sub format_sourceroot {
424: my $text=&trim($parser->get_text('/sourceroot'));
425: $text=$sourceroot if $sourceroot;
426: $parser->get_tag('/sourceroot');
427: if ($mode eq 'html') {
428: return $sourceroot="\n<br />SOURCEROOT: $text";
429: }
430: elsif ($mode eq 'install' or $mode eq 'build' or
431: $mode eq 'configinstall') {
432: return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
433: }
434: else {
435: return '';
436: }
437: }
438: # --------------------------------------------------- Format categories section
439: sub format_categories {
440: my $text=&trim($parser->get_text('/categories'));
441: $parser->get_tag('/categories');
442: if ($mode eq 'html') {
443: return $categories="\n<br />BEGIN CATEGORIES\n$text\n".
444: "<br />END CATEGORIES\n";
445: }
446: else {
447: return '';
448: }
449: }
450: # --------------------------------------------------- Format categories section
451: sub format_category {
452: my (@tokeninfo)=@_;
453: $category_att_name=$tokeninfo[2]->{'name'};
454: $category_att_type=$tokeninfo[2]->{'type'};
455: $chmod='';$chown='';
456: $parser->get_text('/category');
457: $parser->get_tag('/category');
458: if ($mode eq 'html') {
459: return $category="\n<br />CATEGORY $category_att_name ".
460: "$category_att_type $chmod $chown";
461: }
462: else {
463: if ($category_att_type eq $categorytype) {
464: my ($user,$group)=split(/\:/,$chown);
465: $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
466: ' -m '.$chmod;
467: }
468: return '';
469: }
470: }
471: # -------------------------------------------------------- Format chown section
472: sub format_chown {
473: my @tokeninfo=@_;
474: $chown='';
475: my $text=&trim($parser->get_text('/chown'));
476: if ($text) {
477: $parser->get_tag('/chown');
478: $chown=$text;
479: }
480: return '';
481: }
482: # -------------------------------------------------------- Format chmod section
483: sub format_chmod {
484: my @tokeninfo=@_;
485: $chmod='';
486: my $text=&trim($parser->get_text('/chmod'));
487: if ($text) {
488: $parser->get_tag('/chmod');
489: $chmod=$text;
490: }
491: return '';
492: }
493: # ---------------------------------------------------------- Format rpm section
494: sub format_rpm {
495: my $text=&trim($parser->get_text('/rpm'));
496: $parser->get_tag('/rpm');
497: if ($mode eq 'html') {
498: return $rpm=<<END;
499: <font size='+2'>Software Package Description</font>
500: <p>
501: <table bgcolor='#ffffff' border='0' cellpadding='10' cellspacing='0'>
502: <tr><td><pre>
503: $text
504: </pre></td></tr>
505: </table>
506: END
507: }
508: elsif ($mode eq 'text') {
509: return $rpm=<<END;
510: Software Package Description
511:
512: $text
513: END
514: }
515: else {
516: return '';
517: }
518: }
519: # --------------------------------------------------- Format rpmSummary section
520: sub format_rpmSummary {
521: my $text=&trim($parser->get_text('/rpmSummary'));
522: $parser->get_tag('/rpmSummary');
523: if ($mode eq 'html') {
524: return $rpmSummary="\nSummary : $text";
525: }
526: elsif ($mode eq 'text') {
527: return $rpmSummary="\nSummary : $text";
528: }
529: else {
530: return '';
531: }
532: }
533: # ------------------------------------------------------ Format rpmName section
534: sub format_rpmName {
535: my $text=&trim($parser->get_text('/rpmName'));
536: $parser->get_tag('/rpmName');
537: if ($mode eq 'html') {
538: return $rpmName="\n<br />RPMNAME $text";
539: }
540: else {
541: return '';
542: }
543: }
544: # --------------------------------------------------- Format rpmVersion section
545: sub format_rpmVersion {
546: my $text=$parser->get_text('/rpmVersion');
547: $parser->get_tag('/rpmVersion');
548: if ($mode eq 'html') {
549: return $rpmVersion="\n<br />RPMVERSION $text";
550: }
551: else {
552: return '';
553: }
554: }
555: # --------------------------------------------------- Format rpmRelease section
556: sub format_rpmRelease {
557: my $text=$parser->get_text('/rpmRelease');
558: $parser->get_tag('/rpmRelease');
559: if ($mode eq 'html') {
560: return $rpmRelease="\n<br />RPMRELEASE $text";
561: }
562: else {
563: return '';
564: }
565: }
566: # ---------------------------------------------------- Format rpmVendor section
567: sub format_rpmVendor {
568: my $text=$parser->get_text('/rpmVendor');
569: $parser->get_tag('/rpmVendor');
570: if ($mode eq 'html') {
571: return $rpmVendor="\n<br />RPMVENDOR $text";
572: }
573: else {
574: return '';
575: }
576: }
577: # ------------------------------------------------- Format rpmBuildRoot section
578: sub format_rpmBuildRoot {
579: my $text=$parser->get_text('/rpmBuildRoot');
580: $parser->get_tag('/rpmBuildRoot');
581: if ($mode eq 'html') {
582: return $rpmBuildRoot="\n<br />RPMBUILDROOT $text";
583: }
584: else {
585: return '';
586: }
587: }
588: # ------------------------------------------------- Format rpmCopyright section
589: sub format_rpmCopyright {
590: my $text=$parser->get_text('/rpmCopyright');
591: $parser->get_tag('/rpmCopyright');
592: if ($mode eq 'html') {
593: return $rpmCopyright="\n<br />RPMCOPYRIGHT $text";
594: }
595: else {
596: return '';
597: }
598: }
599: # ----------------------------------------------------- Format rpmGroup section
600: sub format_rpmGroup {
601: my $text=$parser->get_text('/rpmGroup');
602: $parser->get_tag('/rpmGroup');
603: if ($mode eq 'html') {
604: return $rpmGroup="\n<br />RPMGROUP $text";
605: }
606: else {
607: return '';
608: }
609: }
610: # ---------------------------------------------------- Format rpmSource section
611: sub format_rpmSource {
612: my $text=$parser->get_text('/rpmSource');
613: $parser->get_tag('/rpmSource');
614: if ($mode eq 'html') {
615: return $rpmSource="\n<br />RPMSOURCE $text";
616: }
617: else {
618: return '';
619: }
620: }
621: # ----------------------------------------------- Format rpmAutoReqProv section
622: sub format_rpmAutoReqProv {
623: my $text=$parser->get_text('/rpmAutoReqProv');
624: $parser->get_tag('/rpmAutoReqProv');
625: if ($mode eq 'html') {
626: return $rpmAutoReqProv="\n<br />RPMAUTOREQPROV $text";
627: }
628: else {
629: return '';
630: }
631: }
632: # ----------------------------------------------- Format rpmdescription section
633: sub format_rpmdescription {
634: my $text=$parser->get_text('/rpmdescription');
635: $parser->get_tag('/rpmdescription');
636: if ($mode eq 'html') {
637: return $rpmdescription="\n<br />RPMDESCRIPTION $text";
638: }
639: else {
640: return '';
641: }
642: }
643: # ------------------------------------------------------- Format rpmpre section
644: sub format_rpmpre {
645: my $text=$parser->get_text('/rpmpre');
646: $parser->get_tag('/rpmpre');
647: if ($mode eq 'html') {
648: return $rpmpre="\n<br />RPMPRE $text";
649: }
650: else {
651: return '';
652: }
653: }
654: # -------------------------------------------------- Format directories section
655: sub format_directories {
656: my $text=$parser->get_text('/directories');
657: $parser->get_tag('/directories');
658: if ($mode eq 'html') {
659: return $directories="\n<br />BEGIN DIRECTORIES\n$text\n<br />".
660: "END DIRECTORIES\n";
661: }
662: elsif ($mode eq 'install') {
663: return "\n".'directories:'."\n".$text;
664: }
665: else {
666: return '';
667: }
668: }
669: # ---------------------------------------------------- Format directory section
670: sub format_directory {
671: my (@tokeninfo)=@_;
672: $targetdir='';$categoryname='';$description='';
673: $parser->get_text('/directory');
674: $parser->get_tag('/directory');
675: if ($mode eq 'html') {
676: return $directory="\n<br />DIRECTORY $targetdir $categoryname ".
677: "$description";
678: }
679: elsif ($mode eq 'install') {
680: return "\t".'install '.$categoryhash{$categoryname}.' -d '.
681: $targetroot.'/'.$targetdir."\n";
682: }
683: else {
684: return '';
685: }
686: }
687: # ---------------------------------------------------- Format targetdir section
688: sub format_targetdir {
689: my @tokeninfo=@_;
690: $targetdir='';
691: my $text=&trim($parser->get_text('/targetdir'));
692: if ($text) {
693: $parser->get_tag('/targetdir');
694: $targetdir=$text;
695: }
696: return '';
697: }
698: # ------------------------------------------------- Format categoryname section
699: sub format_categoryname {
700: my @tokeninfo=@_;
701: $categoryname='';
702: my $text=&trim($parser->get_text('/categoryname'));
703: if ($text) {
704: $parser->get_tag('/categoryname');
705: $categoryname=$text;
706: }
707: return '';
708: }
709: # -------------------------------------------------- Format description section
710: sub format_description {
711: my @tokeninfo=@_;
712: $description='';
713: my $text=&htmlsafe(&trim($parser->get_text('/description')));
714: if ($text) {
715: $parser->get_tag('/description');
716: $description=$text;
717: }
718: return '';
719: }
720: # -------------------------------------------------------- Format files section
721: sub format_files {
722: my $text=$parser->get_text('/files');
723: $parser->get_tag('/files');
724: if ($mode eq 'html') {
725: return $directories="\n<br />BEGIN FILES\n$text\n<br />END FILES\n";
726: }
727: elsif ($mode eq 'install') {
728: return "\n".'files:'."\n".$text.
729: "\n".'links:'."\n".join('',@links);
730: }
731: elsif ($mode eq 'configinstall') {
732: return "\n".'configfiles: '.
733: join(' ',@configall).
734: "\n\n".$text.
735: "\n\nalwaysrun:\n\n";
736: }
737: elsif ($mode eq 'build') {
738: my $binfo;
739: my $tword;
740: my $command2;
741: my @deps;
742: foreach my $bi (@buildinfo) {
743: my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi);
744: $tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
745: $command=~s/\/([^\/]*)$//;
746: $command2="cd $command; sh ./$1;\\";
747: my $depstring;
748: my $depstring2="\t\t\@echo '';\\\n";
749: my $olddep;
750: foreach my $dep (@deps) {
751: unless ($olddep) {
752: $olddep=$deps[$#deps];
753: }
754: $depstring.="\telif !(test -r $command/$dep);\\\n";
755: $depstring.="\t\tthen echo ".
756: "\"**** WARNING **** missing the file: ".
757: "$command/$dep\"$logcmd;\\\n";
758: $depstring.="\t\ttest -e $source || test -e $target || echo ".
759: "'**** ERROR **** neither source=$source nor target=".
760: "$target exist and they cannot be built'$logcmd;\\\n";
761: $depstring.="\t\tmake -f Makefile.build ${source}___DEPS;\\\n";
762: if ($olddep) {
763: $depstring2.="\t\tECODE=0;\\\n";
764: $depstring2.="\t\t! test -e $source && test -r $command/$olddep &&".
765: " { 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";
766: }
767: $olddep=$dep;
768: }
769: $binfo.="$source: $tword\n".
770: "\t\@if !(echo \"\");\\\n\t\tthen echo ".
771: "\"**** WARNING **** Strange shell. ".
772: "Check your path settings.\"$logcmd;\\\n".
773: $depstring.
774: "\telse \\\n\t\t$command2\n\tfi\n\n";
775: $binfo.="${source}___DEPS:\n".$depstring2."\t\tECODE=0;\n\n";
776: }
777: return 'all: '.join(' ',@buildall)."\n\n".
778: $text.
779: $binfo."\n".
780: "alwaysrun:\n\n";
781: }
782: else {
783: return '';
784: }
785: }
786: # ---------------------------------------------------- Format fileglobs section
787: sub format_fileglobs {
788:
789: }
790: # -------------------------------------------------------- Format links section
791: # deprecated.. currently <link></link>'s are included in <files></files>
792: sub format_links {
793: my $text=$parser->get_text('/links');
794: $parser->get_tag('/links');
795: if ($mode eq 'html') {
796: return $links="\n<br />BEGIN LINKS\n$text\n<br />END LINKS\n";
797: }
798: elsif ($mode eq 'install') {
799: return "\n".'links:'."\n\t".$text;
800: }
801: else {
802: return '';
803: }
804: }
805: # --------------------------------------------------------- Format file section
806: sub format_file {
807: my @tokeninfo=@_;
808: $file=''; $source=''; $target=''; $categoryname=''; $description='';
809: $note=''; $build=''; $status=''; $dependencies='';
810: my $text=&trim($parser->get_text('/file'));
811: my $buildtest;
812: if ($source) {
813: $parser->get_tag('/file');
814: if ($mode eq 'html') {
815: return ($file="\n<br />BEGIN FILE\n".
816: "$source $target $categoryname $description $note " .
817: "$build $status $dependencies" .
818: "\nEND FILE");
819: }
820: elsif ($mode eq 'install' && $categoryname ne 'conf') {
821: if ($build) {
822: my $bi=$sourceroot.'/'.$source.';'.$build.';'.
823: $dependencies;
824: my ($source2,$command,$trigger,@deps)=split(/\;/,$bi);
825: $tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
826: $command=~s/\/([^\/]*)$//;
827: $command2="cd $command; sh ./$1;\\";
828: my $depstring;
829: foreach my $dep (@deps) {
830: $depstring.=<<END;
831: ECODE=0; DEP=''; \\
832: test -e $command/$dep || (echo '**** WARNING **** cannot evaluate status of dependency $command/$dep (for building ${sourceroot}/${source} with)'$logcmd); DEP="1"; \\
833: [ -n DEP ] && { perl filecompare.pl -b2 $command/$dep ${targetroot}/${target} || ECODE=\$\$?; } || DEP="1"; \\
834: case "\$\$ECODE" in \\
835: 2) echo "**** WARNING **** dependency $command/$dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\
836: esac; \\
837: END
838: }
839: chomp $depstring;
840: $buildtest=<<END;
841: \@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\
842: echo "**** ERROR **** ${sourceroot}/${source} is missing and is also not present at target location ${targetroot}/${target}; you must run make build"$logcmd; exit; \\
843: END
844: $buildtest.=<<END if $depstring;
845: elif !(test -e "${sourceroot}/${source}"); then \\
846: $depstring
847: END
848: $buildtest.=<<END;
849: fi
850: END
851: }
852: my $bflag='-b1';
853: $bflag='-b3' if $dependencies or $buildlink;
854: return <<END;
855: $buildtest \@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\
856: echo "**** ERROR **** CVS source file does not exist: ${sourceroot}/${source} and neither does target: ${targetroot}/${target}"$logcmd; \\
857: elif !(test -e "${sourceroot}/${source}"); then \\
858: echo "**** WARNING **** CVS source file does not exist: ${sourceroot}/${source}"$logcmd; \\
859: perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
860: else \\
861: ECODE=0; \\
862: perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${target} || ECODE=\$\$?; \\
863: case "\$\$ECODE" in \\
864: 1) echo "${targetroot}/${target} is unchanged";; \\
865: 2) echo "**** WARNING **** target file ${targetroot}/${target} is newer than CVS source; saving current (old) target file to ${targetroot}/${target}.lpmlsave and then overwriting"$logcmd && install -o www -g www -m 0600 ${targetroot}/${target} ${targetroot}/${target}.lpmlsave && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
866: 0) echo "install $categoryhash{$categorname} ${sourceroot}/${source} ${targetroot}/${target}" && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
867: esac; \\
868: perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
869: fi
870: END
871: # return "\t".'@test -e '.$sourceroot.'/'.$source.
872: # ' && perl filecompare.pl -b '.$sourceroot.'/'.$source.' '.
873: # $targetroot.'/'.$target.
874: # ' && install '.
875: # $categoryhash{$categoryname}.' '.
876: # $sourceroot.'/'.$source.' '.
877: # $targetroot.'/'.$target.
878: # ' || echo "**** WARNING '.
879: # '**** CVS source file does not exist: '.$sourceroot.'/'.
880: # $source.'"'."\n";
881: }
882: elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
883: push @configall,$targetroot.'/'.$target;
884: return $targetroot.'/'.$target.': alwaysrun'."\n".
885: "\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 '.
886: $sourceroot.'/'.$source.' '.$targetroot.'/'.$target.
887: ' || ECODE=$$?; } && '.
888: '{ [ $$ECODE != "2" ] || (install '.
889: $categoryhash{$categoryname}.' '.
890: $sourceroot.'/'.$source.' '.
891: $targetroot.'/'.$target.'.lpmlnew'.
892: ' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'.
893: $logcmd.' && echo "'.
894: 'You likely need to compare contents of '.
895: ''.$targetroot.'/'.$target.' with the new '.
896: ''.$targetroot.'/'.$target.'.lpmlnew"'.
897: "$logcmd); } && ".
898: '{ [ $$ECODE != "3" ] || (install '.
899: $categoryhash{$categoryname}.' '.
900: $sourceroot.'/'.$source.' '.
901: $targetroot.'/'.$target.''.
902: ' && echo "**** WARNING: NEW CONFIGURATION FILE ADDED ****"'.
903: $logcmd.' && echo "'.
904: 'You likely need to review the contents of '.
905: ''.$targetroot.'/'.$target.' to make sure its '.
906: 'settings are compatible with your overall system"'.
907: "$logcmd); } && ".
908: '{ [ $$ECODE != "1" ] || ('.
909: 'echo "**** ERROR ****"'.
910: $logcmd.' && echo "'.
911: 'Configuration source file does not exist '.
912: ''.$sourceroot.'/'.$source.'"'.
913: "$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"$categoryhash{$categoryname}\"$logcmd;\n\n";
914: }
915: elsif ($mode eq 'build' && $build) {
916: push @buildall,$sourceroot.'/'.$source;
917: push @buildinfo,$targetroot.'/'.$target.';'.$sourceroot.'/'.
918: $source.';'.$build.';'.
919: $dependencies;
920: # return '# need to build '.$source.";
921: }
922: else {
923: return '';
924: }
925: }
926: return '';
927: }
928: # --------------------------------------------------------- Format link section
929: sub format_link {
930: my @tokeninfo=@_;
931: $link=''; $linkto=''; $target=''; $categoryname=''; $description='';
932: $note=''; $build=''; $status=''; $dependencies='';
933: my $text=&trim($parser->get_text('/link'));
934: if ($linkto) {
935: $parser->get_tag('/link');
936: if ($mode eq 'html') {
937: return $link="\n<br />BEGIN LINK\n".
938: "$linkto $target $categoryname $description $note " .
939: "$build $status $dependencies" .
940: "\nEND LINK";
941: }
942: elsif ($mode eq 'install') {
943: my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
944: foreach my $tgt (@targets) {
945: push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt.
946: "\n";
947: }
948: return '';
949: }
950: else {
951: return '';
952: }
953: }
954: return '';
955: }
956: # ----------------------------------------------------- Format fileglob section
957: sub format_fileglob {
958: my @tokeninfo=@_;
959: $fileglob=''; $glob=''; $sourcedir='';
960: $targetdir=''; $categoryname=''; $description='';
961: $note=''; $build=''; $status=''; $dependencies='';
962: $filenames='';
963: my $text=&trim($parser->get_text('/fileglob'));
964: if ($sourcedir) {
965: $parser->get_tag('/fileglob');
966: if ($mode eq 'html') {
967: return $fileglob="\n<br />BEGIN FILEGLOB\n".
968: "$glob sourcedir $targetdir $categoryname $description $note ".
969: "$build $status $dependencies $filenames" .
970: "\nEND FILEGLOB";
971: }
972: elsif ($mode eq 'install') {
973: return "\t".'install '.
974: $categoryhash{$categoryname}.' '.
975: $sourceroot.'/'.$sourcedir.'[^C][^V][^S]'.$glob.' '.
976: $targetroot.'/'.$targetdir.'.'."\n";
977: }
978: else {
979: return '';
980: }
981: }
982: return '';
983: }
984: # ---------------------------------------------------- Format sourcedir section
985: sub format_sourcedir {
986: my @tokeninfo=@_;
987: $sourcedir='';
988: my $text=&trim($parser->get_text('/sourcedir'));
989: if ($text) {
990: $parser->get_tag('/sourcedir');
991: $sourcedir=$text;
992: }
993: return '';
994: }
995: # ------------------------------------------------------- Format target section
996: sub format_target {
997: my @tokeninfo=@_;
998: $target='';
999: my $text=&trim($parser->get_text('/target'));
1000: if ($text) {
1001: $parser->get_tag('/target');
1002: $target=$text;
1003: }
1004: return '';
1005: }
1006: # ------------------------------------------------------- Format source section
1007: sub format_source {
1008: my @tokeninfo=@_;
1009: $source='';
1010: my $text=&trim($parser->get_text('/source'));
1011: if ($text) {
1012: $parser->get_tag('/source');
1013: $source=$text;
1014: }
1015: return '';
1016: }
1017: # --------------------------------------------------------- Format note section
1018: sub format_note {
1019: my @tokeninfo=@_;
1020: $note='';
1021: my $text=&trim($parser->get_text('/note'));
1022: if ($text) {
1023: $parser->get_tag('/note');
1024: $note=$text;
1025: }
1026: return '';
1027:
1028: }
1029: # -------------------------------------------------------- Format build section
1030: sub format_build {
1031: my @tokeninfo=@_;
1032: $build='';
1033: my $text=&trim($parser->get_text('/build'));
1034: if ($text) {
1035: $parser->get_tag('/build');
1036: $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
1037: }
1038: return '';
1039: }
1040: # -------------------------------------------------------- Format build section
1041: sub format_buildlink {
1042: my @tokeninfo=@_;
1043: $buildlink='';
1044: my $text=&trim($parser->get_text('/buildlink'));
1045: if ($text) {
1046: $parser->get_tag('/buildlink');
1047: $buildlink=$sourceroot.'/'.$text;
1048: }
1049: return '';
1050: }
1051: # ------------------------------------------------------- Format status section
1052: sub format_status {
1053: my @tokeninfo=@_;
1054: $status='';
1055: my $text=&trim($parser->get_text('/status'));
1056: if ($text) {
1057: $parser->get_tag('/status');
1058: $status=$text;
1059: }
1060: return '';
1061: }
1062: # ------------------------------------------------- Format dependencies section
1063: sub format_dependencies {
1064: my @tokeninfo=@_;
1065: $dependencies='';
1066: my $text=&trim($parser->get_text('/dependencies'));
1067: if ($text) {
1068: $parser->get_tag('/dependencies');
1069: $dependencies=join(';',
1070: (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
1071: }
1072: return '';
1073: }
1074: # --------------------------------------------------------- Format glob section
1075: sub format_glob {
1076: my @tokeninfo=@_;
1077: $glob='';
1078: my $text=&trim($parser->get_text('/glob'));
1079: if ($text) {
1080: $parser->get_tag('/glob');
1081: $glob=$text;
1082: }
1083: return '';
1084: }
1085: # ---------------------------------------------------- Format filenames section
1086: sub format_filenames {
1087: my @tokeninfo=@_;
1088: my $text=&trim($parser->get_text('/filenames'));
1089: if ($text) {
1090: $parser->get_tag('/filenames');
1091: $filenames=$text;
1092: }
1093: return '';
1094: }
1095: # ------------------------------------------------------- Format linkto section
1096: sub format_linkto {
1097: my @tokeninfo=@_;
1098: my $text=&trim($parser->get_text('/linkto'));
1099: if ($text) {
1100: $parser->get_tag('/linkto');
1101: $linkto=$text;
1102: }
1103: return '';
1104: }
1105: # ------------------------------------- Render less-than and greater-than signs
1106: sub htmlsafe {
1107: my $text=@_[0];
1108: $text =~ s/</</g;
1109: $text =~ s/>/>/g;
1110: return $text;
1111: }
1112: # --------------------------------------- remove starting and ending whitespace
1113: sub trim {
1114: my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
1115: }
1116:
1117: # ----------------------------------- POD (plain old documentation, CPAN style)
1118:
1119: =head1 NAME
1120:
1121: lpml_parse.pl - This is meant to parse files meeting the lpml document type.
1122: See lpml.dtd. LPML=Linux Packaging Markup Language.
1123:
1124: =head1 SYNOPSIS
1125:
1126: Usage is for lpml file to come in through standard input.
1127:
1128: =over 4
1129:
1130: =item *
1131:
1132: 1st argument is the mode of parsing.
1133:
1134: =item *
1135:
1136: 2nd argument is the category permissions to use (runtime or development)
1137:
1138: =item *
1139:
1140: 3rd argument is the distribution
1141: (default,redhat6.2,debian2.2,redhat7.1,etc).
1142:
1143: =item *
1144:
1145: 4th argument is to manually specify a sourceroot.
1146:
1147: =item *
1148:
1149: 5th argument is to manually specify a targetroot.
1150:
1151: =back
1152:
1153: Only the 1st argument is mandatory for the program to run.
1154:
1155: Example:
1156:
1157: cat ../../doc/loncapafiles.lpml |\\
1158: perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install
1159:
1160: =head1 DESCRIPTION
1161:
1162: I am using a multiple pass-through approach to parsing
1163: the lpml file. This saves memory and makes sure the server
1164: will never be overloaded.
1165:
1166: =head1 README
1167:
1168: I am using a multiple pass-through approach to parsing
1169: the lpml file. This saves memory and makes sure the server
1170: will never be overloaded.
1171:
1172: =head1 PREREQUISITES
1173:
1174: HTML::TokeParser
1175:
1176: =head1 COREQUISITES
1177:
1178: =head1 OSNAMES
1179:
1180: linux
1181:
1182: =head1 SCRIPT CATEGORIES
1183:
1184: Packaging/Administrative
1185:
1186: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lpml_parse.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build