[LON-CAPA-cvs] cvs: loncom /build piml_parse.pl
harris41
lon-capa-cvs@mail.lon-capa.org
Tue, 03 Dec 2002 22:36:32 -0000
This is a MIME encoded message
--harris411038954992
Content-Type: text/plain
harris41 Tue Dec 3 17:36:32 2002 EDT
Modified files:
/loncom/build piml_parse.pl
Log:
BUG 1018 FIXED; fixing command-line argument handling; "dist" tag processing
of *.piml files is now effective; fixing documentation; minor code
beautification
--harris411038954992
Content-Type: text/plain
Content-Disposition: attachment; filename="harris41-20021203173632.txt"
Index: loncom/build/piml_parse.pl
diff -u loncom/build/piml_parse.pl:1.9 loncom/build/piml_parse.pl:1.10
--- loncom/build/piml_parse.pl:1.9 Tue Dec 3 16:37:08 2002
+++ loncom/build/piml_parse.pl Tue Dec 3 17:36:32 2002
@@ -1,14 +1,14 @@
#!/usr/bin/perl
# -------------------------------------------------------- Documentation notice
-# Run "perldoc ./lpml_parse.pl" in order to best view the software
+# Run "perldoc ./piml_parse.pl" in order to best view the software
# documentation internalized in this program.
# --------------------------------------------------------- License Information
# The LearningOnline Network with CAPA
# piml_parse.pl - Linux Packaging Markup Language parser
#
-# $Id: piml_parse.pl,v 1.9 2002/12/03 21:37:08 harris41 Exp $
+# $Id: piml_parse.pl,v 1.10 2002/12/03 22:36:32 harris41 Exp $
#
# Written by Scott Harrison, codeharrison@yahoo.com
#
@@ -61,51 +61,56 @@
# This is meant to parse files meeting the piml document type.
# See piml.dtd. PIML=Post Installation Markup Language.
+# To reduce system dependencies, I'm using a lightweight
+# parser. At some point, I need to get serious with a
+# better xml parsing engine and stylesheet usage.
use HTML::TokeParser;
my $usage=(<<END);
**** ERROR ERROR ERROR ERROR ****
Usage is for piml file to come in through standard input.
1st argument is the category permissions to use (runtime or development)
-2nd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).
+2nd argument is the distribution (default,redhat6,debian2.2,redhat7,etc).
3rd argument is to manually specify a targetroot
Only the 1st argument is mandatory for the program to run.
Example:
-cat ../../doc/loncapafiles.piml |\\
-perl piml_parse.pl html development default /home/sherbert/loncapa /tmp/install
+cat ../../doc/sanitycheck.piml |\\
+perl piml_parse.pl development default /home/sherbert/loncapa
END
# ------------------------------------------------- Grab command line arguments
-my $mode;
-if (@ARGV==3) {
- $mode = shift @ARGV;
-}
-else {
- @ARGV=();shift @ARGV;
+# If number of arguments is incorrect, then give up and print usage message.
+unless (@ARGV == 3)
+ {
+ @ARGV=();shift(@ARGV);
while(<>){} # throw away the input to avoid broken pipes
- print $usage;
+ print($usage); # print usage message
exit -1; # exit with error status
-}
+ }
my $categorytype;
-if (@ARGV) {
- $categorytype = shift @ARGV;
-}
+if (@ARGV)
+ {
+ $categorytype = shift(@ARGV);
+ }
my $dist;
-if (@ARGV) {
- $dist = shift @ARGV;
-}
+if (@ARGV)
+ {
+ $dist = shift(@ARGV);
+ }
my $targetroot;
my $targetrootarg;
-if (@ARGV) {
- $targetroot = shift @ARGV;
-}
+if (@ARGV)
+ {
+ $targetroot = shift(@ARGV);
+ }
+
$targetroot=~s/\/$//;
$targetrootarg=$targetroot;
@@ -113,14 +118,15 @@
my $invocation;
# --------------------------------------------------- Record program invocation
-if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
+if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build')
+ {
$invocation=(<<END);
# Invocation: STDINPUT | piml_parse.pl
# 1st argument (category type) is: $categorytype
# 2nd argument (distribution) is: $dist
# 3rd argument (targetroot) is: described below
END
-}
+ }
# ---------------------------------------------------- Start first pass through
my @parsecontents = <>;
@@ -140,24 +146,29 @@
$parser->xml_mode('1');
my %hash;
my $key;
-while ($token = $parser->get_token()) {
- if ($token->[0] eq 'S') {
+while ($token = $parser->get_token())
+ {
+ if ($token->[0] eq 'S')
+ {
$hloc++;
$hierarchy[$hloc]++;
$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
my $thisdist=' '.$token->[2]{'dist'}.' ';
- if ($thisdist eq ' default ') {
+ if ($thisdist eq ' default ')
+ {
$hash{$key}=1; # there is a default setting for this key
- }
- elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {
+ }
+ elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/)
+ {
$hash{$key}=2; # disregard default setting for this key if
# there is a directly requested distribution match
- }
- }
- if ($token->[0] eq 'E') {
+ }
+ }
+ if ($token->[0] eq 'E')
+ {
$hloc--;
- }
-}
+ }
+ }
# --------------------------------------------------- Start second pass through
undef $hloc;
@@ -283,7 +294,8 @@
undef(@hierarchy);
my $hloc;
my @hierarchy2;
-while ($token = $parser->get_tag('piml')) {
+while ($token = $parser->get_tag('piml'))
+ {
&format_piml(@{$token});
$text = &trim($parser->get_text('/piml'));
$token = $parser->get_tag('/piml');
@@ -292,7 +304,7 @@
print($text);
print("\n");
print(&end());
-}
+ }
exit(0);
# ---------- Functions (most all just format contents of different markup tags)
@@ -320,6 +332,7 @@
END
}
+
# --------------------------------------------------- Format targetroot section
sub format_targetroot {
my $text=&trim($parser->get_text('/targetroot'));
@@ -327,6 +340,7 @@
$parser->get_tag('/targetroot');
return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n");
}
+
# -------------------------------------------------- Format perl script section
sub format_perlscript {
my (@tokeninfo)=@_;
@@ -346,18 +360,21 @@
return($text);
}
}
+
# --------------------------------------------------------------- Format TARGET
sub format_TARGET {
my (@tokeninfo)=@_;
$parser->get_tag('/TARGET');
return($target);
}
+
# --------------------------------------------------- Format categories section
sub format_categories {
my $text=&trim($parser->get_text('/categories'));
$parser->get_tag('/categories');
return('# CATEGORIES'."\n".$text);
}
+
# --------------------------------------------------- Format categories section
sub format_category {
my (@tokeninfo)=@_;
@@ -374,6 +391,7 @@
}
return('');
}
+
# --------------------------------------------------- Format categories section
sub format_abbreviation {
my @tokeninfo=@_;
@@ -385,6 +403,7 @@
}
return('');
}
+
# -------------------------------------------------------- Format chown section
sub format_chown {
my @tokeninfo=@_;
@@ -396,6 +415,7 @@
}
return('');
}
+
# -------------------------------------------------------- Format chmod section
sub format_chmod {
my @tokeninfo=@_;
@@ -407,6 +427,7 @@
}
return('');
}
+
# ------------------------------------------------- Format categoryname section
sub format_categoryname {
my @tokeninfo=@_;
@@ -418,6 +439,7 @@
}
return('');
}
+
# -------------------------------------------------------- Format files section
sub format_files {
my $text=$parser->get_text('/files');
@@ -425,6 +447,7 @@
return("\n".'# There are '.$file_count.' files this script works on'.
"\n\n".$text);
}
+
# --------------------------------------------------------- Format file section
sub format_file {
my @tokeninfo=@_;
@@ -437,6 +460,7 @@
return("# File: $target\n".
"$text\n");
}
+
# ------------------------------------------------------- Format target section
sub format_target {
my @tokeninfo=@_;
@@ -448,6 +472,7 @@
}
return('');
}
+
# --------------------------------------------------------- Format note section
sub format_note {
my @tokeninfo=@_;
@@ -473,6 +498,7 @@
}
return('');
}
+
# ------------------------------------------------- Format dependencies section
sub format_dependencies {
my @tokeninfo=@_;
@@ -485,16 +511,19 @@
}
return('');
}
+
# ------------------------------------------------ Format specialnotice section
sub format_specialnotices {
$parser->get_tag('/specialnotices');
return('');
}
+
# ------------------------------------------------ Format specialnotice section
sub format_specialnotice {
$parser->get_tag('/specialnotice');
return('');
}
+
# ------------------------------------- Render less-than and greater-than signs
sub htmlsafe {
my $text=@_[0];
@@ -502,6 +531,7 @@
$text =~ s/>/>/g;
return($text);
}
+
# --------------------------------------- remove starting and ending whitespace
sub trim {
my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return($s);
@@ -513,7 +543,8 @@
=head1 NAME
-piml_parse.pl - This is meant to parse piml files (Post Installation Markup Language)
+piml_parse.pl - This is meant to parse files meeting the piml document type.
+See piml.dtd. PIML=Post Installation Markup Language.
=head1 SYNOPSIS
@@ -528,7 +559,7 @@
=item *
2nd argument is the distribution
-(default,redhat6.2,debian2.2,redhat7.1,etc).
+(default,redhat6,debian2.2,redhat7,etc).
=item *
@@ -541,7 +572,7 @@
Example:
cat ../../doc/loncapafiles.piml |\\
-perl piml_parse.pl html default /home/sherbert/loncapa /tmp/install
+perl piml_parse.pl development default /home/sherbert/loncapa
=head1 DESCRIPTION
@@ -572,7 +603,7 @@
=head1 AUTHOR
Scott Harrison
- codeharrison@yahoo.com
+ sharrison@users.sourceforge.net
Please let me know how/if you are finding this script useful and
any/all suggestions. -Scott
--harris411038954992--