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