Annotation of loncom/build/piml_parse.pl, revision 1.5

1.1       harris41    1: #!/usr/bin/perl
                      2: 
                      3: # The LearningOnline Network with CAPA
                      4: # piml_parse.pl - Linux Packaging Markup Language parser
                      5: #
1.5     ! harris41    6: # $Id: piml_parse.pl,v 1.4 2002/02/05 01:29:22 harris41 Exp $
1.1       harris41    7: #
                      8: # Written by Scott Harrison, harris41@msu.edu
                      9: #
                     10: # Copyright Michigan State University Board of Trustees
                     11: #
                     12: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     13: #
                     14: # LON-CAPA is free software; you can redistribute it and/or modify
                     15: # it under the terms of the GNU General Public License as published by
                     16: # the Free Software Foundation; either version 2 of the License, or
                     17: # (at your option) any later version.
                     18: #
                     19: # LON-CAPA is distributed in the hope that it will be useful,
                     20: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     21: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     22: # GNU General Public License for more details.
                     23: #
                     24: # You should have received a copy of the GNU General Public License
                     25: # along with LON-CAPA; if not, write to the Free Software
                     26: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     27: #
                     28: # /home/httpd/html/adm/gpl.txt
                     29: #
                     30: # http://www.lon-capa.org/
                     31: #
                     32: # YEAR=2002
1.3       harris41   33: # 1/28,1/29,1/30,1/31 - Scott Harrison
1.1       harris41   34: #
                     35: ###
                     36: 
                     37: ###############################################################################
                     38: ##                                                                           ##
                     39: ## ORGANIZATION OF THIS PERL SCRIPT                                          ##
                     40: ## 1. Notes                                                                  ##
                     41: ## 2. Get command line arguments                                             ##
                     42: ## 3. First pass through (grab distribution-specific information)            ##
                     43: ## 4. Second pass through (parse out what is not necessary)                  ##
                     44: ## 5. Third pass through (translate markup according to specified mode)      ##
                     45: ## 6. Functions (most all just format contents of different markup tags)     ##
                     46: ## 7. POD (plain old documentation, CPAN style)                              ##
                     47: ##                                                                           ##
                     48: ###############################################################################
                     49: 
                     50: # ----------------------------------------------------------------------- Notes
                     51: #
                     52: # I am using a multiple pass-through approach to parsing
                     53: # the piml file.  This saves memory and makes sure the server
                     54: # will never be overloaded.
                     55: #
                     56: # This is meant to parse files meeting the piml document type.
                     57: # See piml.dtd.  PIML=Post Installation Markup Language.
                     58: 
                     59: use HTML::TokeParser;
                     60: 
                     61: my $usage=<<END;
                     62: **** ERROR ERROR ERROR ERROR ****
                     63: Usage is for piml file to come in through standard input.
1.2       harris41   64: 1st argument is the category permissions to use (runtime or development)
                     65: 2nd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).
                     66: 3rd argument is to manually specify a targetroot
1.1       harris41   67: 
                     68: Only the 1st argument is mandatory for the program to run.
                     69: 
                     70: Example:
                     71: 
                     72: cat ../../doc/loncapafiles.piml |\\
                     73: perl piml_parse.pl html development default /home/sherbert/loncapa /tmp/install
                     74: END
                     75: 
                     76: # ------------------------------------------------- Grab command line arguments
                     77: 
                     78: my $mode;
1.3       harris41   79: if (@ARGV==3) {
1.1       harris41   80:     $mode = shift @ARGV;
                     81: }
                     82: else {
                     83:     @ARGV=();shift @ARGV;
                     84:     while(<>){} # throw away the input to avoid broken pipes
                     85:     print $usage;
                     86:     exit -1; # exit with error status
                     87: }
                     88: 
                     89: my $categorytype;
                     90: if (@ARGV) {
                     91:     $categorytype = shift @ARGV;
                     92: }
                     93: 
                     94: my $dist;
                     95: if (@ARGV) {
                     96:     $dist = shift @ARGV;
                     97: }
                     98: 
                     99: my $targetroot;
                    100: my $targetrootarg;
                    101: if (@ARGV) {
                    102:     $targetroot = shift @ARGV;
                    103: }
                    104: $targetroot=~s/\/$//;
                    105: $targetrootarg=$targetroot;
                    106: 
                    107: my $logcmd='| tee -a WARNINGS';
                    108: 
                    109: my $invocation;
                    110: # --------------------------------------------------- Record program invocation
                    111: if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
                    112:     $invocation=(<<END);
                    113: # Invocation: STDINPUT | piml_parse.pl
1.2       harris41  114: #             1st argument (category type) is: $categorytype
                    115: #             2nd argument (distribution) is: $dist
                    116: #             3rd argument (targetroot) is: described below
1.1       harris41  117: END
                    118: }
                    119: 
                    120: # ---------------------------------------------------- Start first pass through
                    121: my @parsecontents = <>;
                    122: my $parsestring = join('',@parsecontents);
                    123: my $outstring;
                    124: 
                    125: # Need to make a pass through and figure out what defaults are
                    126: # overrided.  Top-down overriding strategy (leaves don't know
                    127: # about distant leaves).
                    128: 
                    129: my @hierarchy;
                    130: $hierarchy[0]=0;
                    131: my $hloc=0;
                    132: my $token;
                    133: $parser = HTML::TokeParser->new(\$parsestring) or
                    134:     die('can\'t create TokeParser object');
                    135: $parser->xml_mode('1');
                    136: my %hash;
                    137: my $key;
                    138: while ($token = $parser->get_token()) {
                    139:     if ($token->[0] eq 'S') {
                    140: 	$hloc++;
                    141: 	$hierarchy[$hloc]++;
                    142: 	$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
                    143: 	my $thisdist=' '.$token->[2]{'dist'}.' ';
                    144: 	if ($thisdist eq ' default ') {
                    145: 	    $hash{$key}=1; # there is a default setting for this key
                    146: 	}
                    147: 	elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {
                    148: 	    $hash{$key}=2; # disregard default setting for this key if
                    149: 	                   # there is a directly requested distribution match
                    150: 	}
                    151:     }
                    152:     if ($token->[0] eq 'E') {
                    153: 	$hloc--;
                    154:     }
                    155: }
                    156: 
                    157: # --------------------------------------------------- Start second pass through
                    158: undef $hloc;
                    159: undef @hierarchy;
                    160: undef $parser;
                    161: $hierarchy[0]=0;
                    162: $parser = HTML::TokeParser->new(\$parsestring) or
                    163:     die('can\'t create TokeParser object');
                    164: $parser->xml_mode('1');
                    165: my $cleanstring;
                    166: while ($token = $parser->get_token()) {
                    167:     if ($token->[0] eq 'S') {
                    168: 	$hloc++;
                    169: 	$hierarchy[$hloc]++;
                    170: 	$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
                    171: 	my $thisdist=' '.$token->[2]{'dist'}.' ';
                    172: 	# This conditional clause is set up to ignore two sets
                    173: 	# of invalid conditions before accepting entry into
                    174: 	# the cleanstring.
                    175: 	if ($hash{$key}==2 and
                    176: 	    !($thisdist eq '  ' or $thisdist =~/\s$dist\s/)) {
                    177: 	    if ($token->[4]!~/\/>$/) {
                    178: 		$parser->get_tag('/'.$token->[1]);
                    179: 		$hloc--;
                    180: 	    }
                    181: 	}
                    182: 	elsif ($thisdist ne '  ' and $thisdist!~/\s$dist\s/ and
                    183: 	       !($thisdist eq ' default ' and $hash{$key}!=2)) {
                    184: 	    if ($token->[4]!~/\/>$/) {
                    185: 		$parser->get_tag('/'.$token->[1]);
                    186: 		$hloc--;
                    187: 	    }
                    188: 	}
                    189: 	else {
                    190: 	    $cleanstring.=$token->[4];
                    191: 	}
                    192: 	if ($token->[4]=~/\/>$/) {
1.4       harris41  193: #	    $hloc--;
1.1       harris41  194: 	}
                    195:     }
                    196:     if ($token->[0] eq 'E') {
                    197: 	$cleanstring.=$token->[2];
                    198: 	$hloc--;
                    199:     }
                    200:     if ($token->[0] eq 'T') {
                    201: 	$cleanstring.=$token->[1];
                    202:     }
                    203: }
                    204: $cleanstring=&trim($cleanstring);
                    205: $cleanstring=~s/\>\s*\n\s*\</\>\</g;
                    206: 
                    207: # ---------------------------------------------------- Start final pass through
                    208: 
                    209: # storage variables
                    210: my $piml;
                    211: my $categories;
                    212: my @categorynamelist;
                    213: my $category;
                    214: my $category_att_name;
                    215: my $category_att_type;
                    216: my $chown;
                    217: my $chmod;
                    218: my $abbreviation; # space-free abbreviation; esp. for image names
                    219: my $categoryname;
                    220: my $description;
                    221: my $files;
                    222: my $file;
                    223: my $target;
                    224: my $note;
                    225: my $commands;
                    226: my $command;
                    227: my $dependencies;
                    228: my @links;
                    229: my %categoryhash;
                    230: my $dpathlength;
                    231: my %fab; # file category abbreviation
                    232: my $directory_count;
                    233: my $file_count;
                    234: my $link_count;
                    235: my $fileglob_count;
                    236: my $fileglobnames_count;
                    237: my %categorycount;
                    238: 
1.4       harris41  239: my $mode;
                    240: 
1.1       harris41  241: my @buildall;
                    242: my @buildinfo;
                    243: 
                    244: my @configall;
                    245: 
                    246: # Make new parser with distribution specific input
                    247: undef $parser;
                    248: $parser = HTML::TokeParser->new(\$cleanstring) or
                    249:     die('can\'t create TokeParser object');
                    250: $parser->xml_mode('1');
                    251: 
                    252: # Define handling methods for mode-dependent text rendering
                    253: 
                    254: $parser->{textify}={
                    255:     specialnotices => \&format_specialnotices,
                    256:     specialnotice => \&format_specialnotice,
                    257:     targetroot => \&format_targetroot,
                    258:     categories => \&format_categories,
                    259:     category => \&format_category,
                    260:     abbreviation => \&format_abbreviation,
                    261:     chown => \&format_chown,
                    262:     chmod => \&format_chmod,
                    263:     categoryname => \&format_categoryname,
                    264:     files => \&format_files,
                    265:     file => \&format_file,
                    266:     target => \&format_target,
                    267:     note => \&format_note,
                    268:     build => \&format_build,
                    269:     dependencies => \&format_dependencies,
                    270:     filenames => \&format_filenames,
1.2       harris41  271:     perlscript => \&format_perlscript,
                    272:     TARGET => \&format_TARGET,
1.1       harris41  273:     };
                    274: 
                    275: my $text;
                    276: my $token;
                    277: undef $hloc;
                    278: undef @hierarchy;
                    279: my $hloc;
                    280: my @hierarchy2;
                    281: while ($token = $parser->get_tag('piml')) {
                    282:     &format_piml(@{$token});
                    283:     $text = &trim($parser->get_text('/piml'));
                    284:     $token = $parser->get_tag('/piml');
                    285:     print $piml; 
                    286:     print "\n";
                    287:     print $text;
                    288:     print "\n";
                    289:     print &end();
                    290: }
                    291: exit;
                    292: 
                    293: # ---------- Functions (most all just format contents of different markup tags)
                    294: 
                    295: # ------------------------ Final output at end of markup parsing and formatting
                    296: sub end {
1.2       harris41  297: 
1.1       harris41  298: }
                    299: 
                    300: # ----------------------- Take in string to parse and the separation expression
                    301: sub extract_array {
                    302:     my ($stringtoparse,$sepexp) = @_;
                    303:     my @a=split(/$sepexp/,$stringtoparse);
                    304:     return \@a;
                    305: }
                    306: 
                    307: # --------------------------------------------------------- Format piml section
                    308: sub format_piml {
                    309:     my (@tokeninfo)=@_;
                    310:     my $date=`date`; chop $date;
1.2       harris41  311:     $piml=<<END;
                    312: #!/usr/bin/perl
1.1       harris41  313: 
1.2       harris41  314: # Generated from a PIML (Post Installation Markup Language) document
1.1       harris41  315: 
                    316: END
                    317: }
                    318: # --------------------------------------------------- Format targetroot section
                    319: sub format_targetroot {
                    320:     my $text=&trim($parser->get_text('/targetroot'));
                    321:     $text=$targetroot if $targetroot;
                    322:     $parser->get_tag('/targetroot');
1.2       harris41  323:     return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
                    324: }
                    325: # -------------------------------------------------- Format perl script section
                    326: sub format_perlscript {
                    327:     my (@tokeninfo)=@_;
1.5     ! harris41  328:     $mode=$tokeninfo[2]->{'mode'};
1.2       harris41  329:     my $text=$parser->get_text('/perlscript');
                    330:     $parser->get_tag('/perlscript');
1.5     ! harris41  331:     if ($mode eq 'bg') {
        !           332: 	open OUT,">/tmp/piml$$.pl";
        !           333: 	print OUT $text;
        !           334: 	close OUT;
        !           335: 	return <<END;
        !           336: 	# launch background process for $target
        !           337: 	system("perl /tmp/piml$$.pl &");
        !           338: END
        !           339:     }
        !           340:     else {
        !           341: 	return $text;
        !           342:     }
1.1       harris41  343: }
1.2       harris41  344: # --------------------------------------------------------------- Format TARGET
                    345: sub format_TARGET {
                    346:     my (@tokeninfo)=@_;
                    347:     $parser->get_tag('/TARGET');
                    348:     return $target;
1.1       harris41  349: }
                    350: # --------------------------------------------------- Format categories section
                    351: sub format_categories {
                    352:     my $text=&trim($parser->get_text('/categories'));
                    353:     $parser->get_tag('/categories');
1.2       harris41  354:     return '# CATEGORIES'."\n".$text;
1.1       harris41  355: }
                    356: # --------------------------------------------------- Format categories section
                    357: sub format_category {
                    358:     my (@tokeninfo)=@_;
                    359:     $category_att_name=$tokeninfo[2]->{'name'};
                    360:     $category_att_type=$tokeninfo[2]->{'type'};
                    361:     $abbreviation=''; $chmod='';$chown='';
                    362:     $parser->get_text('/category');
                    363:     $parser->get_tag('/category');
                    364:     $fab{$category_att_name}=$abbreviation;
1.2       harris41  365:     if ($category_att_type eq $categorytype) {
                    366: 	my ($user,$group)=split(/\:/,$chown);
                    367: 	$categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
                    368: 	    ' -m '.$chmod;
1.1       harris41  369:     }
1.2       harris41  370:     return '';
1.1       harris41  371: }
                    372: # --------------------------------------------------- Format categories section
                    373: sub format_abbreviation {
                    374:     my @tokeninfo=@_;
                    375:     $abbreviation='';
                    376:     my $text=&trim($parser->get_text('/abbreviation'));
                    377:     if ($text) {
                    378: 	$parser->get_tag('/abbreviation');
                    379: 	$abbreviation=$text;
                    380:     }
                    381:     return '';
                    382: }
                    383: # -------------------------------------------------------- Format chown section
                    384: sub format_chown {
                    385:     my @tokeninfo=@_;
                    386:     $chown='';
                    387:     my $text=&trim($parser->get_text('/chown'));
                    388:     if ($text) {
                    389: 	$parser->get_tag('/chown');
                    390: 	$chown=$text;
                    391:     }
                    392:     return '';
                    393: }
                    394: # -------------------------------------------------------- Format chmod section
                    395: sub format_chmod {
                    396:     my @tokeninfo=@_;
                    397:     $chmod='';
                    398:     my $text=&trim($parser->get_text('/chmod'));
                    399:     if ($text) {
                    400: 	$parser->get_tag('/chmod');
                    401: 	$chmod=$text;
                    402:     }
                    403:     return '';
                    404: }
                    405: # ------------------------------------------------- Format categoryname section
                    406: sub format_categoryname {
                    407:     my @tokeninfo=@_;
                    408:     $categoryname='';
                    409:     my $text=&trim($parser->get_text('/categoryname'));
                    410:     if ($text) {
                    411: 	$parser->get_tag('/categoryname');
                    412: 	$categoryname=$text;
                    413:     }
                    414:     return '';
                    415: }
                    416: # -------------------------------------------------------- Format files section
                    417: sub format_files {
                    418:     my $text=$parser->get_text('/files');
                    419:     $parser->get_tag('/files');
1.2       harris41  420:     return "\n".'# There are '.$file_count.' files this script works on'.
                    421: 	"\n\n".$text;
1.1       harris41  422: }
                    423: # --------------------------------------------------------- Format file section
                    424: sub format_file {
                    425:     my @tokeninfo=@_;
                    426:     $file=''; $source=''; $target=''; $categoryname=''; $description='';
                    427:     $note=''; $build=''; $status=''; $dependencies='';
                    428:     my $text=&trim($parser->get_text('/file'));
                    429:     $file_count++;
                    430:     $categorycount{$categoryname}++;
1.2       harris41  431:     $parser->get_tag('/file');
                    432:     return "# File: $target\n".
                    433: 	"$text\n";
1.1       harris41  434:     return '';
                    435: }
                    436: # ------------------------------------------------------- Format target section
                    437: sub format_target {
                    438:     my @tokeninfo=@_;
                    439:     $target='';
                    440:     my $text=&trim($parser->get_text('/target'));
                    441:     if ($text) {
                    442: 	$parser->get_tag('/target');
1.2       harris41  443: 	$target=$targetrootarg.$text;
1.1       harris41  444:     }
                    445:     return '';
                    446: }
                    447: # --------------------------------------------------------- Format note section
                    448: sub format_note {
                    449:     my @tokeninfo=@_;
                    450:     $note='';
                    451:     my $aref;
                    452:     my $text;
                    453:     while ($aref=$parser->get_token()) {
                    454: 	if ($aref->[0] eq 'E' && $aref->[1] eq 'note') {
                    455: 	    last;
                    456: 	}
                    457: 	elsif ($aref->[0] eq 'S') {
                    458: 	    $text.=$aref->[4];
                    459: 	}
                    460: 	elsif ($aref->[0] eq 'E') {
                    461: 	    $text.=$aref->[2];
                    462: 	}
                    463: 	else {
                    464: 	    $text.=$aref->[1];
                    465: 	}
                    466:     }
                    467:     if ($text) {
                    468: 	$note=$text;
                    469:     }
                    470:     return '';
                    471: 
                    472: }
                    473: # ------------------------------------------------- Format dependencies section
                    474: sub format_dependencies {
                    475:     my @tokeninfo=@_;
                    476:     $dependencies='';
                    477:     my $text=&trim($parser->get_text('/dependencies'));
                    478:     if ($text) {
                    479: 	$parser->get_tag('/dependencies');
                    480: 	$dependencies=join(';',
                    481: 			      (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
                    482:     }
                    483:     return '';
                    484: }
                    485: # ------------------------------------------------ Format specialnotice section
                    486: sub format_specialnotices {
                    487:     $parser->get_tag('/specialnotices');
                    488:     return '';
                    489: }
                    490: # ------------------------------------------------ Format specialnotice section
                    491: sub format_specialnotice {
                    492:     $parser->get_tag('/specialnotice');
                    493:     return '';
                    494: }
                    495: # ------------------------------------- Render less-than and greater-than signs
                    496: sub htmlsafe {
                    497:     my $text=@_[0];
                    498:     $text =~ s/</&lt;/g;
                    499:     $text =~ s/>/&gt;/g;
                    500:     return $text;
                    501: }
                    502: # --------------------------------------- remove starting and ending whitespace
                    503: sub trim {
                    504:     my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
                    505: } 
                    506: 
                    507: # ----------------------------------- POD (plain old documentation, CPAN style)
                    508: 
                    509: =head1 NAME
                    510: 
                    511: piml_parse.pl - This is meant to parse files meeting the piml document type.
1.2       harris41  512: See piml.dtd.  PIML=Post Installation Markup Language.
1.1       harris41  513: 
                    514: =head1 SYNOPSIS
                    515: 
                    516: Usage is for piml file to come in through standard input.
                    517: 
                    518: =over 4
                    519: 
                    520: =item * 
                    521: 
1.2       harris41  522: 1st argument is the category permissions to use (runtime or development)
1.1       harris41  523: 
                    524: =item *
                    525: 
1.2       harris41  526: 2nd argument is the distribution
1.1       harris41  527: (default,redhat6.2,debian2.2,redhat7.1,etc).
                    528: 
                    529: =item *
                    530: 
1.2       harris41  531: 3rd argument is to manually specify a targetroot.
1.1       harris41  532: 
                    533: =back
                    534: 
                    535: Only the 1st argument is mandatory for the program to run.
                    536: 
                    537: Example:
                    538: 
                    539: cat ../../doc/loncapafiles.piml |\\
                    540: perl piml_parse.pl html default /home/sherbert/loncapa /tmp/install
                    541: 
                    542: =head1 DESCRIPTION
                    543: 
                    544: I am using a multiple pass-through approach to parsing
                    545: the piml file.  This saves memory and makes sure the server
                    546: will never be overloaded.
                    547: 
                    548: =head1 README
                    549: 
                    550: I am using a multiple pass-through approach to parsing
                    551: the piml file.  This saves memory and makes sure the server
                    552: will never be overloaded.
                    553: 
                    554: =head1 PREREQUISITES
                    555: 
                    556: HTML::TokeParser
                    557: 
                    558: =head1 COREQUISITES
                    559: 
                    560: =head1 OSNAMES
                    561: 
                    562: linux
                    563: 
                    564: =head1 SCRIPT CATEGORIES
                    565: 
                    566: Packaging/Administrative
                    567: 
                    568: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>