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

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

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