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:
233: # Make new parser with distribution specific input
234: undef $parser;
235: $parser = HTML::TokeParser->new(\$cleanstring) or
236: die('can\'t create TokeParser object');
237: $parser->xml_mode('1');
238:
239: # Define handling methods for mode-dependent text rendering
240: $parser->{textify}={
241: targetroot => \&format_targetroot,
242: sourceroot => \&format_sourceroot,
243: categories => \&format_categories,
244: category => \&format_category,
245: targetdir => \&format_targetdir,
246: chown => \&format_chown,
247: chmod => \&format_chmod,
248: rpm => \&format_rpm,
249: rpmSummary => \&format_rpmSummary,
250: rpmName => \&format_rpmName,
251: rpmVersion => \&format_rpmVersion,
252: rpmRelease => \&format_rpmRelease,
253: rpmVendor => \&format_rpmVendor,
254: rpmBuildRoot => \&format_rpmBuildRoot,
255: rpmCopyright => \&format_rpmCopyright,
256: rpmGroup => \&format_rpmGroup,
257: rpmSource => \&format_rpmSource,
258: rpmAutoReqProv => \&format_rpmAutoReqProv,
259: rpmdescription => \&format_rpmdescription,
260: rpmpre => \&format_rpmpre,
261: directories => \&format_directories,
262: directory => \&format_directory,
263: categoryname => \&format_categoryname,
264: description => \&format_description,
265: files => \&format_files,
266: file => \&format_file,
267: fileglob => \&format_fileglob,
268: links => \&format_links,
269: link => \&format_link,
270: linkto => \&format_linkto,
271: source => \&format_source,
272: target => \&format_target,
273: note => \&format_note,
274: build => \&format_build,
275: status => \&format_status,
276: dependencies => \&format_dependencies,
277: glob => \&format_glob,
278: sourcedir => \&format_sourcedir,
279: filenames => \&format_filenames,
280: };
281:
282: my $text;
283: my $token;
284: undef $hloc;
285: undef @hierarchy;
286: my $hloc;
287: my @hierarchy2;
288: while ($token = $parser->get_tag('lpml')) {
289: &format_lpml(@{$token});
290: $text = &trim($parser->get_text('/lpml'));
291: $token = $parser->get_tag('/lpml');
292: print $lpml;
293: print "\n";
294: # $text=~s/\s*\n\s*\n\s*/\n/g;
295: print $text;
296: print "\n";
297: print &end();
298: }
299: exit;
300:
301: sub end {
302: if ($mode eq 'html') {
303: return "<br />THE END\n";
304: }
305: if ($mode eq 'install') {
306: return '';
307: }
308: }
309:
310: # ----------------------- Take in string to parse and the separation expression
311: sub extract_array {
312: my ($stringtoparse,$sepexp) = @_;
313: my @a=split(/$sepexp/,$stringtoparse);
314: return \@a;
315: }
316:
317: # --------------------------------------------------------- Format lpml section
318: sub format_lpml {
319: my (@tokeninfo)=@_;
320: my $date=`date`; chop $date;
321: if ($mode eq 'html') {
322: $lpml = "<br />LPML BEGINNING: $date";
323: }
324: elsif ($mode eq 'install') {
325: print '# LPML install targets. Linux Packaging Markup Language,';
326: print ' by Scott Harrison 2001'."\n";
327: print '# This file was automatically generated on '.`date`;
328: print "\n".$invocation;
329: }
330: elsif ($mode eq 'build') {
331: $lpml = "# Dynamic Makefile generated by LON-CAPA build process\n";
332: $lpml .= '# This file was automatically generated on '.`date`;
333: $lpml .= "\n";
334: $lpml .= "SHELL=\"/bin/sh\"\n\n";
335: }
336: else {
337: return '';
338: }
339: }
340: # --------------------------------------------------- Format targetroot section
341: sub format_targetroot {
342: my $text=&trim($parser->get_text('/targetroot'));
343: $text=$targetroot if $targetroot;
344: $parser->get_tag('/targetroot');
345: if ($mode eq 'html') {
346: return $targetroot="\n<br />TARGETROOT: $text";
347: }
348: elsif ($mode eq 'install') {
349: return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
350: }
351: elsif ($mode eq 'build') {
352: return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
353: }
354: else {
355: return '';
356: }
357: }
358: # --------------------------------------------------- Format sourceroot section
359: sub format_sourceroot {
360: my $text=&trim($parser->get_text('/sourceroot'));
361: $text=$sourceroot if $sourceroot;
362: $parser->get_tag('/sourceroot');
363: if ($mode eq 'html') {
364: return $sourceroot="\n<br />SOURCEROOT: $text";
365: }
366: elsif ($mode eq 'install') {
367: return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
368: }
369: elsif ($mode eq 'build') {
370: return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
371: }
372: else {
373: return '';
374: }
375: }
376: # --------------------------------------------------- Format categories section
377: sub format_categories {
378: my $text=&trim($parser->get_text('/categories'));
379: $parser->get_tag('/categories');
380: if ($mode eq 'html') {
381: return $categories="\n<br />BEGIN CATEGORIES\n$text\n".
382: "<br />END CATEGORIES\n";
383: }
384: else {
385: return '';
386: }
387: }
388: # --------------------------------------------------- Format categories section
389: sub format_category {
390: my (@tokeninfo)=@_;
391: $category_att_name=$tokeninfo[2]->{'name'};
392: $category_att_type=$tokeninfo[2]->{'type'};
393: $chmod='';$chown='';
394: $parser->get_text('/category');
395: $parser->get_tag('/category');
396: if ($mode eq 'html') {
397: return $category="\n<br />CATEGORY $category_att_name ".
398: "$category_att_type $chmod $chown";
399: }
400: else {
401: if ($category_att_type eq $categorytype) {
402: my ($user,$group)=split(/\:/,$chown);
403: $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
404: ' -m '.$chmod;
405: }
406: return '';
407: }
408: }
409: # -------------------------------------------------------- Format chown section
410: sub format_chown {
411: my @tokeninfo=@_;
412: $chown='';
413: my $text=&trim($parser->get_text('/chown'));
414: if ($text) {
415: $parser->get_tag('/chown');
416: $chown=$text;
417: }
418: return '';
419: }
420: # -------------------------------------------------------- Format chmod section
421: sub format_chmod {
422: my @tokeninfo=@_;
423: $chmod='';
424: my $text=&trim($parser->get_text('/chmod'));
425: if ($text) {
426: $parser->get_tag('/chmod');
427: $chmod=$text;
428: }
429: return '';
430: }
431: # ---------------------------------------------------------- Format rpm section
432: sub format_rpm {
433: my $text=&trim($parser->get_text('/rpm'));
434: $parser->get_tag('/rpm');
435: if ($mode eq 'html') {
436: return $rpm="\n<br />BEGIN RPM\n$text\n<br />END RPM";
437: }
438: else {
439: return '';
440: }
441: }
442: # --------------------------------------------------- Format rpmSummary section
443: sub format_rpmSummary {
444: my $text=&trim($parser->get_text('/rpmSummary'));
445: $parser->get_tag('/rpmSummary');
446: if ($mode eq 'html') {
447: return $rpmSummary="\n<br />RPMSUMMARY $text";
448: }
449: else {
450: return '';
451: }
452: }
453: # ------------------------------------------------------ Format rpmName section
454: sub format_rpmName {
455: my $text=&trim($parser->get_text('/rpmName'));
456: $parser->get_tag('/rpmName');
457: if ($mode eq 'html') {
458: return $rpmName="\n<br />RPMNAME $text";
459: }
460: else {
461: return '';
462: }
463: }
464: # --------------------------------------------------- Format rpmVersion section
465: sub format_rpmVersion {
466: my $text=$parser->get_text('/rpmVersion');
467: $parser->get_tag('/rpmVersion');
468: if ($mode eq 'html') {
469: return $rpmVersion="\n<br />RPMVERSION $text";
470: }
471: else {
472: return '';
473: }
474: }
475: # --------------------------------------------------- Format rpmRelease section
476: sub format_rpmRelease {
477: my $text=$parser->get_text('/rpmRelease');
478: $parser->get_tag('/rpmRelease');
479: if ($mode eq 'html') {
480: return $rpmRelease="\n<br />RPMRELEASE $text";
481: }
482: else {
483: return '';
484: }
485: }
486: # ---------------------------------------------------- Format rpmVendor section
487: sub format_rpmVendor {
488: my $text=$parser->get_text('/rpmVendor');
489: $parser->get_tag('/rpmVendor');
490: if ($mode eq 'html') {
491: return $rpmVendor="\n<br />RPMVENDOR $text";
492: }
493: else {
494: return '';
495: }
496: }
497: # ------------------------------------------------- Format rpmBuildRoot section
498: sub format_rpmBuildRoot {
499: my $text=$parser->get_text('/rpmBuildRoot');
500: $parser->get_tag('/rpmBuildRoot');
501: if ($mode eq 'html') {
502: return $rpmBuildRoot="\n<br />RPMBUILDROOT $text";
503: }
504: else {
505: return '';
506: }
507: }
508: # ------------------------------------------------- Format rpmCopyright section
509: sub format_rpmCopyright {
510: my $text=$parser->get_text('/rpmCopyright');
511: $parser->get_tag('/rpmCopyright');
512: if ($mode eq 'html') {
513: return $rpmCopyright="\n<br />RPMCOPYRIGHT $text";
514: }
515: else {
516: return '';
517: }
518: }
519: # ----------------------------------------------------- Format rpmGroup section
520: sub format_rpmGroup {
521: my $text=$parser->get_text('/rpmGroup');
522: $parser->get_tag('/rpmGroup');
523: if ($mode eq 'html') {
524: return $rpmGroup="\n<br />RPMGROUP $text";
525: }
526: else {
527: return '';
528: }
529: }
530: # ---------------------------------------------------- Format rpmSource section
531: sub format_rpmSource {
532: my $text=$parser->get_text('/rpmSource');
533: $parser->get_tag('/rpmSource');
534: if ($mode eq 'html') {
535: return $rpmSource="\n<br />RPMSOURCE $text";
536: }
537: else {
538: return '';
539: }
540: }
541: # ----------------------------------------------- Format rpmAutoReqProv section
542: sub format_rpmAutoReqProv {
543: my $text=$parser->get_text('/rpmAutoReqProv');
544: $parser->get_tag('/rpmAutoReqProv');
545: if ($mode eq 'html') {
546: return $rpmAutoReqProv="\n<br />RPMAUTOREQPROV $text";
547: }
548: else {
549: return '';
550: }
551: }
552: # ----------------------------------------------- Format rpmdescription section
553: sub format_rpmdescription {
554: my $text=$parser->get_text('/rpmdescription');
555: $parser->get_tag('/rpmdescription');
556: if ($mode eq 'html') {
557: return $rpmdescription="\n<br />RPMDESCRIPTION $text";
558: }
559: else {
560: return '';
561: }
562: }
563: # ------------------------------------------------------- Format rpmpre section
564: sub format_rpmpre {
565: my $text=$parser->get_text('/rpmpre');
566: $parser->get_tag('/rpmpre');
567: if ($mode eq 'html') {
568: return $rpmpre="\n<br />RPMPRE $text";
569: }
570: else {
571: return '';
572: }
573: }
574: # -------------------------------------------------- Format directories section
575: sub format_directories {
576: my $text=$parser->get_text('/directories');
577: $parser->get_tag('/directories');
578: if ($mode eq 'html') {
579: return $directories="\n<br />BEGIN DIRECTORIES\n$text\n<br />".
580: "END DIRECTORIES\n";
581: }
582: elsif ($mode eq 'install') {
583: return "\n".'directories:'."\n".$text;
584: }
585: else {
586: return '';
587: }
588: }
589: # ---------------------------------------------------- Format directory section
590: sub format_directory {
591: my (@tokeninfo)=@_;
592: $targetdir='';$categoryname='';$description='';
593: $parser->get_text('/directory');
594: $parser->get_tag('/directory');
595: if ($mode eq 'html') {
596: return $directory="\n<br />DIRECTORY $targetdir $categoryname ".
597: "$description";
598: }
599: elsif ($mode eq 'install') {
600: return "\t".'install '.$categoryhash{$categoryname}.' -d '.
601: $targetroot.'/'.$targetdir."\n";
602: }
603: else {
604: return '';
605: }
606: }
607: # ---------------------------------------------------- Format targetdir section
608: sub format_targetdir {
609: my @tokeninfo=@_;
610: $targetdir='';
611: my $text=&trim($parser->get_text('/targetdir'));
612: if ($text) {
613: $parser->get_tag('/targetdir');
614: $targetdir=$text;
615: }
616: return '';
617: }
618: # ------------------------------------------------- Format categoryname section
619: sub format_categoryname {
620: my @tokeninfo=@_;
621: $categoryname='';
622: my $text=&trim($parser->get_text('/categoryname'));
623: if ($text) {
624: $parser->get_tag('/categoryname');
625: $categoryname=$text;
626: }
627: return '';
628: }
629: # -------------------------------------------------- Format description section
630: sub format_description {
631: my @tokeninfo=@_;
632: $description='';
633: my $text=&htmlsafe(&trim($parser->get_text('/description')));
634: if ($text) {
635: $parser->get_tag('/description');
636: $description=$text;
637: }
638: return '';
639: }
640: # -------------------------------------------------------- Format files section
641: sub format_files {
642: my $text=$parser->get_text('/files');
643: $parser->get_tag('/files');
644: if ($mode eq 'html') {
645: return $directories="\n<br />BEGIN FILES\n$text\n<br />END FILES\n";
646: }
647: elsif ($mode eq 'install') {
648: return "\n".'files:'."\n".$text.
649: "\n".'links:'."\n".join('',@links);
650: }
651: elsif ($mode eq 'build') {
652: my $binfo;
653: my $tword;
654: my $command2;
655: my @deps;
656: foreach my $bi (@buildinfo) {
657: my ($source,$command,$trigger,@deps)=split(/\;/,$bi);
658: $tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
659: $command=~s/\/([^\/]*)$//;
660: $command2="cd $command; sh ./$1;\\";
661: my $depstring;
662: foreach my $dep (@deps) {
663: $depstring.="\telif !(test -r $command/$dep);\\\n";
664: $depstring.="\t\tthen echo ".
665: "\"**** LON-CAPA WARNING **** missing the file: ".
666: "$command/$dep\";\\\n";
667: }
668: $binfo.="$source: $tword\n".
669: "\t\@if !(echo \"\");\\\n\t\tthen echo ".
670: "\"**** LON-CAPA WARNING **** Strange shell. ".
671: "Check your path settings.\";\\\n".
672: $depstring.
673: "\telse \\\n\t\t$command2\n\tfi\n\n";
674: }
675: return 'all: '.join(' ',@buildall)."\n\n".
676: $text.
677: $binfo."\n".
678: "alwaysrun:\n\n";
679: }
680: else {
681: return '';
682: }
683: }
684: # ---------------------------------------------------- Format fileglobs section
685: sub format_fileglobs {
686:
687: }
688: # -------------------------------------------------------- Format links section
689: # deprecated.. currently <link></link>'s are included in <files></files>
690: sub format_links {
691: my $text=$parser->get_text('/links');
692: $parser->get_tag('/links');
693: if ($mode eq 'html') {
694: return $links="\n<br />BEGIN LINKS\n$text\n<br />END LINKS\n";
695: }
696: elsif ($mode eq 'install') {
697: return "\n".'links:'."\n\t".$text;
698: }
699: else {
700: return '';
701: }
702: }
703: # --------------------------------------------------------- Format file section
704: sub format_file {
705: my @tokeninfo=@_;
706: $file=''; $source=''; $target=''; $categoryname=''; $description='';
707: $note=''; $build=''; $status=''; $dependencies='';
708: my $text=&trim($parser->get_text('/file'));
709: if ($source) {
710: $parser->get_tag('/file');
711: if ($mode eq 'html') {
712: return ($file="\n<br />BEGIN FILE\n".
713: "$source $target $categoryname $description $note " .
714: "$build $status $dependencies" .
715: "\nEND FILE");
716: }
717: elsif ($mode eq 'install' && $categoryname ne 'conf') {
718: return "\t".'@test -e '.$sourceroot.'/'.$source.
719: ' && install '.
720: $categoryhash{$categoryname}.' '.
721: $sourceroot.'/'.$source.' '.
722: $targetroot.'/'.$target.
723: ' || echo "**** LON-CAPA WARNING '.
724: '**** CVS source file does not exist: '.$sourceroot.'/'.
725: $source.'"'."\n";
726: }
727: elsif ($mode eq 'build' && $build) {
728: push @buildall,$sourceroot.'/'.$source;
729: push @buildinfo,$sourceroot.'/'.$source.';'.$build.';'.
730: $dependencies;
731: # return '# need to build '.$source.";
732: }
733: else {
734: return '';
735: }
736: }
737: return '';
738: }
739: # --------------------------------------------------------- Format link section
740: sub format_link {
741: my @tokeninfo=@_;
742: $link=''; $linkto=''; $target=''; $categoryname=''; $description='';
743: $note=''; $build=''; $status=''; $dependencies='';
744: my $text=&trim($parser->get_text('/link'));
745: if ($linkto) {
746: $parser->get_tag('/link');
747: if ($mode eq 'html') {
748: return $link="\n<br />BEGIN LINK\n".
749: "$linkto $target $categoryname $description $note " .
750: "$build $status $dependencies" .
751: "\nEND LINK";
752: }
753: elsif ($mode eq 'install') {
754: my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target);
755: foreach my $tgt (@targets) {
756: push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt.
757: "\n";
758: }
759: return '';
760: }
761: else {
762: return '';
763: }
764: }
765: return '';
766: }
767: # ----------------------------------------------------- Format fileglob section
768: sub format_fileglob {
769: my @tokeninfo=@_;
770: $fileglob=''; $glob=''; $sourcedir='';
771: $targetdir=''; $categoryname=''; $description='';
772: $note=''; $build=''; $status=''; $dependencies='';
773: $filenames='';
774: my $text=&trim($parser->get_text('/fileglob'));
775: if ($sourcedir) {
776: $parser->get_tag('/fileglob');
777: if ($mode eq 'html') {
778: return $fileglob="\n<br />BEGIN FILEGLOB\n".
779: "$glob sourcedir $targetdir $categoryname $description $note ".
780: "$build $status $dependencies $filenames" .
781: "\nEND FILEGLOB";
782: }
783: elsif ($mode eq 'install') {
784: return "\t".'install '.
785: $categoryhash{$categoryname}.' '.
786: $sourceroot.'/'.$sourcedir.'[^CVS]'.$glob.' '.
787: $targetroot.'/'.$targetdir.'.'."\n";
788: }
789: else {
790: return '';
791: }
792: }
793: return '';
794: }
795: # ---------------------------------------------------- Format sourcedir section
796: sub format_sourcedir {
797: my @tokeninfo=@_;
798: $sourcedir='';
799: my $text=&trim($parser->get_text('/sourcedir'));
800: if ($text) {
801: $parser->get_tag('/sourcedir');
802: $sourcedir=$text;
803: }
804: return '';
805: }
806: # ------------------------------------------------------- Format target section
807: sub format_target {
808: my @tokeninfo=@_;
809: $target='';
810: my $text=&trim($parser->get_text('/target'));
811: if ($text) {
812: $parser->get_tag('/target');
813: $target=$text;
814: }
815: return '';
816: }
817: # ------------------------------------------------------- Format source section
818: sub format_source {
819: my @tokeninfo=@_;
820: $source='';
821: my $text=&trim($parser->get_text('/source'));
822: if ($text) {
823: $parser->get_tag('/source');
824: $source=$text;
825: }
826: return '';
827: }
828: # --------------------------------------------------------- Format note section
829: sub format_note {
830: my @tokeninfo=@_;
831: $note='';
832: my $text=&trim($parser->get_text('/note'));
833: if ($text) {
834: $parser->get_tag('/note');
835: $note=$text;
836: }
837: return '';
838:
839: }
840: # -------------------------------------------------------- Format build section
841: sub format_build {
842: my @tokeninfo=@_;
843: $build='';
844: my $text=&trim($parser->get_text('/build'));
845: if ($text) {
846: $parser->get_tag('/build');
847: $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
848: }
849: return '';
850: }
851: # ------------------------------------------------------- Format status section
852: sub format_status {
853: my @tokeninfo=@_;
854: $status='';
855: my $text=&trim($parser->get_text('/status'));
856: if ($text) {
857: $parser->get_tag('/status');
858: $status=$text;
859: }
860: return '';
861: }
862: # ------------------------------------------------- Format dependencies section
863: sub format_dependencies {
864: my @tokeninfo=@_;
865: $dependencies='';
866: my $text=&trim($parser->get_text('/dependencies'));
867: if ($text) {
868: $parser->get_tag('/dependencies');
869: $dependencies=join(';',
870: (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
871: }
872: return '';
873: }
874: # --------------------------------------------------------- Format glob section
875: sub format_glob {
876: my @tokeninfo=@_;
877: $glob='';
878: my $text=&trim($parser->get_text('/glob'));
879: if ($text) {
880: $parser->get_tag('/glob');
881: $glob=$text;
882: }
883: return '';
884: }
885: # ---------------------------------------------------- Format filenames section
886: sub format_filenames {
887: my @tokeninfo=@_;
888: my $text=&trim($parser->get_text('/filenames'));
889: if ($text) {
890: $parser->get_tag('/filenames');
891: $filenames=$text;
892: }
893: return '';
894: }
895: # ------------------------------------------------------- Format linkto section
896: sub format_linkto {
897: my @tokeninfo=@_;
898: my $text=&trim($parser->get_text('/linkto'));
899: if ($text) {
900: $parser->get_tag('/linkto');
901: $linkto=$text;
902: }
903: return '';
904: }
905: # ------------------------------------- Render less-than and greater-than signs
906: sub htmlsafe {
907: my $text=@_[0];
908: $text =~ s/</</g;
909: $text =~ s/>/>/g;
910: return $text;
911: }
912: # --------------------------------------- remove starting and ending whitespace
913: sub trim {
914: my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
915: }
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