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

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

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