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