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