Annotation of loncom/build/lpml_parse.pl, revision 1.13

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

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