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 - 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: # ---------------------------------------------------- Start first pass through
83: my @parsecontents = <>;
84: my $parsestring = join('',@parsecontents);
85: my $outstring;
86:
87: # Need to make a pass through and figure out what defaults are
88: # overrided. Top-down overriding strategy (leaves don't know
89: # about distant leaves).
90:
91: my @hierarchy;
92: $hierarchy[0]=0;
93: my $hloc=0;
94: my $token;
95: $parser = HTML::TokeParser->new(\$parsestring) or
96: die('can\'t create TokeParser object');
97: $parser->xml_mode('1');
98: my %hash;
99: my $key;
100: while ($token = $parser->get_token()) {
101: if ($token->[0] eq 'S') {
102: $hloc++;
103: $hierarchy[$hloc]++;
104: $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
105: my $thisdist=' '.$token->[2]{'dist'}.' ';
106: if ($thisdist eq ' default ') {
107: $hash{$key}=1; # there is a default setting for this key
108: }
109: elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {
110: $hash{$key}=2; # disregard default setting for this key if
111: # there is a directly requested distribution match
112: }
113: }
114: if ($token->[0] eq 'E') {
115: $hloc--;
116: }
117: }
118:
119: # --------------------------------------------------- Start second pass through
120: undef $hloc;
121: undef @hierarchy;
122: undef $parser;
123: $hierarchy[0]=0;
124: $parser = HTML::TokeParser->new(\$parsestring) or
125: die('can\'t create TokeParser object');
126: $parser->xml_mode('1');
127: my $cleanstring;
128: while ($token = $parser->get_token()) {
129: if ($token->[0] eq 'S') {
130: $hloc++;
131: $hierarchy[$hloc]++;
132: $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
133: my $thisdist=' '.$token->[2]{'dist'}.' ';
134: # This conditional clause is set up to ignore two sets
135: # of invalid conditions before accepting entry into
136: # the cleanstring.
137: if ($hash{$key}==2 and
138: !($thisdist eq ' ' or $thisdist =~/\s$dist\s/)) {
139: if ($token->[4]!~/\/>$/) {
140: $parser->get_tag('/'.$token->[1]);
141: $hloc--;
142: }
143: }
144: elsif ($thisdist ne ' ' and $thisdist!~/\s$dist\s/ and
145: !($thisdist eq ' default ' and $hash{$key}!=2)) {
146: if ($token->[4]!~/\/>$/) {
147: $parser->get_tag('/'.$token->[1]);
148: $hloc--;
149: }
150: }
151: else {
152: $cleanstring.=$token->[4];
153: }
154: if ($token->[4]=~/\/>$/) {
155: $hloc--;
156: }
157: }
158: if ($token->[0] eq 'E') {
159: $cleanstring.=$token->[2];
160: $hloc--;
161: }
162: if ($token->[0] eq 'T') {
163: $cleanstring.=$token->[1];
164: }
165: }
166: $cleanstring=&trim($cleanstring);
167: $cleanstring=~s/\s*\n\s*//g;
168: # ---------------------------------------------------- Start final pass through
169:
170: # storage variables
171: my $lpml;
172: my $categories;
173: my $category;
174: my $category_att_name;
175: my $category_att_type;
176: my $chown;
177: my $chmod;
178: my $rpm;
179: my $rpmSummary;
180: my $rpmName;
181: my $rpmVersion;
182: my $rpmRelease;
183: my $rpmVendor;
184: my $rpmBuildRoot;
185: my $rpmCopyright;
186: my $rpmGroup;
187: my $rpmSource;
188: my $rpmAutoReqProv;
189: my $rpmdescription;
190: my $rpmpre;
191: my $directories;
192: my $directory;
193: my $targetdirs;
194: my $targetdir;
195: my $categoryname;
196: my $description;
197: my $files;
198: my $fileglobs;
199: my $links;
200: my $file;
201: my $link;
202: my $fileglob;
203: my $sourcedir;
204: my $targets;
205: my $target;
206: my $source;
207: my $note;
208: my $build;
209: my $commands;
210: my $command;
211: my $status;
212: my $dependencies;
213: my $dependency;
214: my @links;
215: my %categoryhash;
216:
217: # Make new parser with distribution specific input
218: undef $parser;
219: $parser = HTML::TokeParser->new(\$cleanstring) or
220: die('can\'t create TokeParser object');
221: $parser->xml_mode('1');
222:
223: # Define handling methods for mode-dependent text rendering
224: $parser->{textify}={
225: targetroot => \&format_targetroot,
226: sourceroot => \&format_sourceroot,
227: categories => \&format_categories,
228: category => \&format_category,
229: targetdir => \&format_targetdir,
230: chown => \&format_chown,
231: chmod => \&format_chmod,
232: rpm => \&format_rpm,
233: rpmSummary => \&format_rpmSummary,
234: rpmName => \&format_rpmName,
235: rpmVersion => \&format_rpmVersion,
236: rpmRelease => \&format_rpmRelease,
237: rpmVendor => \&format_rpmVendor,
238: rpmBuildRoot => \&format_rpmBuildRoot,
239: rpmCopyright => \&format_rpmCopyright,
240: rpmGroup => \&format_rpmGroup,
241: rpmSource => \&format_rpmSource,
242: rpmAutoReqProv => \&format_rpmAutoReqProv,
243: rpmdescription => \&format_rpmdescription,
244: rpmpre => \&format_rpmpre,
245: directories => \&format_directories,
246: directory => \&format_directory,
247: categoryname => \&format_categoryname,
248: description => \&format_description,
249: files => \&format_files,
250: file => \&format_file,
251: fileglob => \&format_fileglob,
252: links => \&format_links,
253: link => \&format_link,
254: linkto => \&format_linkto,
255: source => \&format_source,
256: target => \&format_target,
257: note => \&format_note,
258: build => \&format_build,
259: status => \&format_status,
260: dependencies => \&format_dependencies,
261: glob => \&format_glob,
262: sourcedir => \&format_sourcedir,
263: filenames => \&format_filenames,
264: };
265:
266: my $text;
267: my $token;
268: undef $hloc;
269: undef @hierarchy;
270: my $hloc;
271: my @hierarchy2;
272: while ($token = $parser->get_tag('lpml')) {
273: &format_lpml(@{$token});
274: $text = &trim($parser->get_text('/lpml'));
275: $token = $parser->get_tag('/lpml');
276: print $lpml;
277: print "\n";
278: # $text=~s/\s*\n\s*\n\s*/\n/g;
279: print $text;
280: print "\n";
281: print &end();
282: }
283: exit;
284:
285: sub end {
286: if ($mode eq 'html') {
287: return "THE END\n";
288: }
289: if ($mode eq 'install') {
290: return '';
291: }
292: }
293:
294: # ----------------------- Take in string to parse and the separation expression
295: sub extract_array {
296: my ($stringtoparse,$sepexp) = @_;
297: my @a=split(/$sepexp/,$stringtoparse);
298: return \@a;
299: }
300:
301: # --------------------------------------------------------- Format lpml section
302: sub format_lpml {
303: my (@tokeninfo)=@_;
304: my $date=`date`; chop $date;
305: if ($mode eq 'html') {
306: $lpml = "LPML BEGINNING: $date";
307: }
308: elsif ($mode eq 'install') {
309: print '# LPML install targets. Linux Packaging Markup Language,';
310: print ' by Scott Harrison 2001'."\n";
311: print '# This file was automatically generated on '.`date`;
312: }
313: else {
314: return '';
315: }
316: }
317: # --------------------------------------------------- Format targetroot section
318: sub format_targetroot {
319: my $text=&trim($parser->get_text('/targetroot'));
320: $text=$targetroot if $targetroot;
321: $parser->get_tag('/targetroot');
322: if ($mode eq 'html') {
323: return $targetroot="\nTARGETROOT: $text";
324: }
325: elsif ($mode eq 'install') {
326: return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
327: }
328: else {
329: return '';
330: }
331: }
332: # --------------------------------------------------- Format sourceroot section
333: sub format_sourceroot {
334: my $text=&trim($parser->get_text('/sourceroot'));
335: $text=$sourceroot if $sourceroot;
336: $parser->get_tag('/sourceroot');
337: if ($mode eq 'html') {
338: return $sourceroot="\nSOURCEROOT: $text";
339: }
340: elsif ($mode eq 'install') {
341: return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
342: }
343: else {
344: return '';
345: }
346: }
347: # --------------------------------------------------- Format categories section
348: sub format_categories {
349: my $text=&trim($parser->get_text('/categories'));
350: $parser->get_tag('/categories');
351: if ($mode eq 'html') {
352: return $categories="\nBEGIN CATEGORIES\n$text\nEND CATEGORIES\n";
353: }
354: else {
355: return '';
356: }
357: }
358: # --------------------------------------------------- Format categories section
359: sub format_category {
360: my (@tokeninfo)=@_;
361: $category_att_name=$tokeninfo[2]->{'name'};
362: $category_att_type=$tokeninfo[2]->{'type'};
363: $chmod='';$chown='';
364: $parser->get_text('/category');
365: $parser->get_tag('/category');
366: if ($mode eq 'html') {
367: return $category="\nCATEGORY $category_att_name $category_att_type ".
368: "$chmod $chown";
369: }
370: else {
371: if ($category_att_type eq $categorytype) {
372: my ($user,$group)=split(/\:/,$chown);
373: $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
374: ' -m '.$chmod;
375: }
376: return '';
377: }
378: }
379: # -------------------------------------------------------- Format chown section
380: sub format_chown {
381: my @tokeninfo=@_;
382: $chown='';
383: my $text=&trim($parser->get_text('/chown'));
384: if ($text) {
385: $parser->get_tag('/chown');
386: $chown=$text;
387: }
388: return '';
389: }
390: # -------------------------------------------------------- Format chmod section
391: sub format_chmod {
392: my @tokeninfo=@_;
393: $chmod='';
394: my $text=&trim($parser->get_text('/chmod'));
395: if ($text) {
396: $parser->get_tag('/chmod');
397: $chmod=$text;
398: }
399: return '';
400: }
401: # ---------------------------------------------------------- Format rpm section
402: sub format_rpm {
403: my $text=&trim($parser->get_text('/rpm'));
404: $parser->get_tag('/rpm');
405: if ($mode eq 'html') {
406: return $rpm="\nBEGIN RPM\n$text\nEND RPM";
407: }
408: else {
409: return '';
410: }
411: }
412: # --------------------------------------------------- Format rpmSummary section
413: sub format_rpmSummary {
414: my $text=&trim($parser->get_text('/rpmSummary'));
415: $parser->get_tag('/rpmSummary');
416: if ($mode eq 'html') {
417: return $rpmSummary="\nRPMSUMMARY $text";
418: }
419: else {
420: return '';
421: }
422: }
423: # ------------------------------------------------------ Format rpmName section
424: sub format_rpmName {
425: my $text=&trim($parser->get_text('/rpmName'));
426: $parser->get_tag('/rpmName');
427: if ($mode eq 'html') {
428: return $rpmName="\nRPMNAME $text";
429: }
430: else {
431: return '';
432: }
433: }
434: # --------------------------------------------------- Format rpmVersion section
435: sub format_rpmVersion {
436: my $text=$parser->get_text('/rpmVersion');
437: $parser->get_tag('/rpmVersion');
438: if ($mode eq 'html') {
439: return $rpmVersion="\nRPMVERSION $text";
440: }
441: else {
442: return '';
443: }
444: }
445: # --------------------------------------------------- Format rpmRelease section
446: sub format_rpmRelease {
447: my $text=$parser->get_text('/rpmRelease');
448: $parser->get_tag('/rpmRelease');
449: if ($mode eq 'html') {
450: return $rpmRelease="\nRPMRELEASE $text";
451: }
452: else {
453: return '';
454: }
455: }
456: # ---------------------------------------------------- Format rpmVendor section
457: sub format_rpmVendor {
458: my $text=$parser->get_text('/rpmVendor');
459: $parser->get_tag('/rpmVendor');
460: if ($mode eq 'html') {
461: return $rpmVendor="\nRPMVENDOR $text";
462: }
463: else {
464: return '';
465: }
466: }
467: # ------------------------------------------------- Format rpmBuildRoot section
468: sub format_rpmBuildRoot {
469: my $text=$parser->get_text('/rpmBuildRoot');
470: $parser->get_tag('/rpmBuildRoot');
471: if ($mode eq 'html') {
472: return $rpmBuildRoot="\nRPMBUILDROOT $text";
473: }
474: else {
475: return '';
476: }
477: }
478: # ------------------------------------------------- Format rpmCopyright section
479: sub format_rpmCopyright {
480: my $text=$parser->get_text('/rpmCopyright');
481: $parser->get_tag('/rpmCopyright');
482: if ($mode eq 'html') {
483: return $rpmCopyright="\nRPMCOPYRIGHT $text";
484: }
485: else {
486: return '';
487: }
488: }
489: # ----------------------------------------------------- Format rpmGroup section
490: sub format_rpmGroup {
491: my $text=$parser->get_text('/rpmGroup');
492: $parser->get_tag('/rpmGroup');
493: if ($mode eq 'html') {
494: return $rpmGroup="\nRPMGROUP $text";
495: }
496: else {
497: return '';
498: }
499: }
500: # ---------------------------------------------------- Format rpmSource section
501: sub format_rpmSource {
502: my $text=$parser->get_text('/rpmSource');
503: $parser->get_tag('/rpmSource');
504: if ($mode eq 'html') {
505: return $rpmSource="\nRPMSOURCE $text";
506: }
507: else {
508: return '';
509: }
510: }
511: # ----------------------------------------------- Format rpmAutoReqProv section
512: sub format_rpmAutoReqProv {
513: my $text=$parser->get_text('/rpmAutoReqProv');
514: $parser->get_tag('/rpmAutoReqProv');
515: if ($mode eq 'html') {
516: return $rpmAutoReqProv="\nRPMAUTOREQPROV $text";
517: }
518: else {
519: return '';
520: }
521: }
522: # ----------------------------------------------- Format rpmdescription section
523: sub format_rpmdescription {
524: my $text=$parser->get_text('/rpmdescription');
525: $parser->get_tag('/rpmdescription');
526: if ($mode eq 'html') {
527: return $rpmdescription="\nRPMDESCRIPTION $text";
528: }
529: else {
530: return '';
531: }
532: }
533: # ------------------------------------------------------- Format rpmpre section
534: sub format_rpmpre {
535: my $text=$parser->get_text('/rpmpre');
536: $parser->get_tag('/rpmpre');
537: if ($mode eq 'html') {
538: return $rpmpre="\nRPMPRE $text";
539: }
540: else {
541: return '';
542: }
543: }
544: # -------------------------------------------------- Format directories section
545: sub format_directories {
546: my $text=$parser->get_text('/directories');
547: $parser->get_tag('/directories');
548: if ($mode eq 'html') {
549: return $directories="\nBEGIN DIRECTORIES\n$text\nEND DIRECTORIES\n";
550: }
551: elsif ($mode eq 'install') {
552: return "\n".'directories:'."\n".$text;
553: }
554: else {
555: return '';
556: }
557: }
558: # ---------------------------------------------------- Format directory section
559: sub format_directory {
560: my (@tokeninfo)=@_;
561: $targetdir='';$categoryname='';$description='';
562: $parser->get_text('/directory');
563: $parser->get_tag('/directory');
564: if ($mode eq 'html') {
565: return $directory="\nDIRECTORY $targetdir $categoryname $description";
566: }
567: elsif ($mode eq 'install') {
568: return "\t".'install '.$categoryhash{$categoryname}.' -d '.
569: $targetroot.$targetdir."\n";
570: }
571: else {
572: return '';
573: }
574: }
575: # ---------------------------------------------------- Format targetdir section
576: sub format_targetdir {
577: my @tokeninfo=@_;
578: $targetdir='';
579: my $text=&trim($parser->get_text('/targetdir'));
580: if ($text) {
581: $parser->get_tag('/targetdir');
582: $targetdir=$text;
583: }
584: return '';
585: }
586: # ------------------------------------------------- Format categoryname section
587: sub format_categoryname {
588: my @tokeninfo=@_;
589: $categoryname='';
590: my $text=&trim($parser->get_text('/categoryname'));
591: if ($text) {
592: $parser->get_tag('/categoryname');
593: $categoryname=$text;
594: }
595: return '';
596: }
597: # -------------------------------------------------- Format description section
598: sub format_description {
599: my @tokeninfo=@_;
600: $description='';
601: my $text=&trim($parser->get_text('/description'));
602: if ($text) {
603: $parser->get_tag('/description');
604: $description=$text;
605: }
606: return '';
607: }
608: # -------------------------------------------------------- Format files section
609: sub format_files {
610: my $text=$parser->get_text('/files');
611: $parser->get_tag('/files');
612: if ($mode eq 'html') {
613: return $directories="\nBEGIN FILES\n$text\nEND FILES\n";
614: }
615: elsif ($mode eq 'install') {
616: return "\n".'files:'."\n".$text.
617: "\n".'links:'."\n".join('',@links);
618: }
619: else {
620: return '';
621: }
622: }
623: # ---------------------------------------------------- Format fileglobs section
624: sub format_fileglobs {
625:
626: }
627: # -------------------------------------------------------- Format links section
628: # deprecated.. currently <link></link>'s are included in <files></files>
629: sub format_links {
630: my $text=$parser->get_text('/links');
631: $parser->get_tag('/links');
632: if ($mode eq 'html') {
633: return $links="\nBEGIN LINKS\n$text\nEND LINKS\n";
634: }
635: elsif ($mode eq 'install') {
636: return "\n".'links:'."\n\t".$text;
637: }
638: else {
639: return '';
640: }
641: }
642: # --------------------------------------------------------- Format file section
643: sub format_file {
644: my @tokeninfo=@_;
645: $file=''; $source=''; $target=''; $categoryname=''; $description='';
646: $note=''; $build=''; $status=''; $dependencies='';
647: my $text=&trim($parser->get_text('/file'));
648: if ($source) {
649: $parser->get_tag('/file');
650: if ($mode eq 'html') {
651: return ($file="\nBEGIN FILE\n".
652: "$source $target $categoryname $description $note " .
653: "$build $status $dependencies" .
654: "\nEND FILE");
655: }
656: elsif ($mode eq 'install') {
657: return "\t".'@test -e '.$sourceroot.$source.
658: '/loncom/html/index.html && install '.
659: $categoryhash{$categoryname}.' '.
660: $sourceroot.$source.'/loncom/html/index.html '.
661: $targetroot.$target.
662: '/home/httpd/html/index.html || echo "**** LON-CAPA WARNING '.
663: '**** CVS source file does not exist: '.$sourceroot.$source.
664: '/loncom/html/index.html"'."\n";
665: }
666: else {
667: return '';
668: }
669: }
670: return '';
671: }
672: # --------------------------------------------------------- Format link section
673: sub format_link {
674: my @tokeninfo=@_;
675: $link=''; $linkto=''; $target=''; $categoryname=''; $description='';
676: $note=''; $build=''; $status=''; $dependencies='';
677: my $text=&trim($parser->get_text('/link'));
678: if ($linkto) {
679: $parser->get_tag('/link');
680: if ($mode eq 'html') {
681: return $link="\nBEGIN LINK\n".
682: "$linkto $target $categoryname $description $note " .
683: "$build $status $dependencies" .
684: "\nEND LINK";
685: }
686: elsif ($mode eq 'install') {
687: push @links,"\t".'ln -s /'.$linkto.' /'.$targetroot.$target.' '.
688: $categoryname."\n";
689: return '';
690: }
691: else {
692: return '';
693: }
694: }
695: return '';
696: }
697: # ----------------------------------------------------- Format fileglob section
698: sub format_fileglob {
699: my @tokeninfo=@_;
700: $fileglob=''; $glob=''; $sourcedir='';
701: $targetdir=''; $categoryname=''; $description='';
702: $note=''; $build=''; $status=''; $dependencies='';
703: $filenames='';
704: my $text=&trim($parser->get_text('/fileglob'));
705: if ($sourcedir) {
706: $parser->get_tag('/fileglob');
707: if ($mode eq 'html') {
708: return $fileglob="\nBEGIN FILEGLOB\n".
709: "$glob sourcedir $targetdir $categoryname $description $note ".
710: "$build $status $dependencies $filenames" .
711: "\nEND FILEGLOB";
712: }
713: else {
714: return '';
715: }
716: }
717: return '';
718: }
719: # ---------------------------------------------------- Format sourcedir section
720: sub format_sourcedir {
721: my @tokeninfo=@_;
722: $sourcedir='';
723: my $text=&trim($parser->get_text('/sourcedir'));
724: if ($text) {
725: $parser->get_tag('/sourcedir');
726: $sourcedir=$text;
727: }
728: return '';
729: }
730: # ------------------------------------------------------- Format target section
731: sub format_target {
732: my @tokeninfo=@_;
733: $target='';
734: my $text=&trim($parser->get_text('/target'));
735: if ($text) {
736: $parser->get_tag('/target');
737: $target=$text;
738: }
739: return '';
740: }
741: # ------------------------------------------------------- Format source section
742: sub format_source {
743: my @tokeninfo=@_;
744: $source='';
745: my $text=&trim($parser->get_text('/source'));
746: if ($text) {
747: $parser->get_tag('/source');
748: $source=$text;
749: }
750: return '';
751: }
752: # --------------------------------------------------------- Format note section
753: sub format_note {
754: my @tokeninfo=@_;
755: $note='';
756: my $text=&trim($parser->get_text('/note'));
757: if ($text) {
758: $parser->get_tag('/note');
759: $note=$text;
760: }
761: return '';
762:
763: }
764: # -------------------------------------------------------- Format build section
765: sub format_build {
766: my @tokeninfo=@_;
767: $build='';
768: my $text=&trim($parser->get_text('/build'));
769: if ($text) {
770: $parser->get_tag('/build');
771: $build=$text;
772: }
773: return '';
774: }
775: # ------------------------------------------------------- Format status section
776: sub format_status {
777: my @tokeninfo=@_;
778: $status='';
779: my $text=&trim($parser->get_text('/status'));
780: if ($text) {
781: $parser->get_tag('/status');
782: $status=$text;
783: }
784: return '';
785: }
786: # ------------------------------------------------- Format dependencies section
787: sub format_dependencies {
788: my @tokeninfo=@_;
789: $dependencies='';
790: my $text=&trim($parser->get_text('/dependencies'));
791: if ($text) {
792: $parser->get_tag('/dependencies');
793: $dependencies=$text;
794: }
795: return '';
796: }
797: # --------------------------------------------------------- Format glob section
798: sub format_glob {
799: my @tokeninfo=@_;
800: $glob='';
801: my $text=&trim($parser->get_text('/glob'));
802: if ($text) {
803: $parser->get_tag('/glob');
804: $glob=$text;
805: }
806: return '';
807: }
808: # ---------------------------------------------------- Format filenames section
809: sub format_filenames {
810: my @tokeninfo=@_;
811: $glob='';
812: my $text=&trim($parser->get_text('/filenames'));
813: if ($text) {
814: $parser->get_tag('/filenames');
815: $filenames=$text;
816: }
817: return '';
818: }
819: # ------------------------------------------------------- Format linkto section
820: sub format_linkto {
821: my @tokeninfo=@_;
822: $glob='';
823: my $text=&trim($parser->get_text('/linkto'));
824: if ($text) {
825: $parser->get_tag('/linkto');
826: $linkto=$text;
827: }
828: return '';
829: }
830: # --------------------------------------- remove starting and ending whitespace
831: sub trim {
832: my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
833: }
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