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