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

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

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