[LON-CAPA-cvs] cvs: loncom /build piml_parse.pl
harris41
lon-capa-cvs@mail.lon-capa.org
Mon, 08 Apr 2002 10:53:17 -0000
harris41 Mon Apr 8 06:53:17 2002 EDT
Modified files:
/loncom/build piml_parse.pl
Log:
beautifying; adding in header information; specifying author
Index: loncom/build/piml_parse.pl
diff -u loncom/build/piml_parse.pl:1.5 loncom/build/piml_parse.pl:1.6
--- loncom/build/piml_parse.pl:1.5 Mon Feb 4 20:49:39 2002
+++ loncom/build/piml_parse.pl Mon Apr 8 06:53:17 2002
@@ -1,11 +1,16 @@
#!/usr/bin/perl
+# -------------------------------------------------------- Documentation notice
+# Run "perldoc ./lpml_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.5 2002/02/05 01:49:39 harris41 Exp $
+# $Id: piml_parse.pl,v 1.6 2002/04/08 10:53:17 harris41 Exp $
#
-# Written by Scott Harrison, harris41@msu.edu
+# Written by Scott Harrison, codeharrison@yahoo.com
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,7 +35,7 @@
# http://www.lon-capa.org/
#
# YEAR=2002
-# 1/28,1/29,1/30,1/31 - Scott Harrison
+# 1/28,1/29,1/30,1/31,2/5,4/8 - Scott Harrison
#
###
@@ -58,7 +63,7 @@
use HTML::TokeParser;
-my $usage=<<END;
+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)
@@ -120,7 +125,7 @@
# ---------------------------------------------------- Start first pass through
my @parsecontents = <>;
my $parsestring = join('',@parsecontents);
-my $outstring;
+my $outstring='';
# Need to make a pass through and figure out what defaults are
# overrided. Top-down overriding strategy (leaves don't know
@@ -129,7 +134,7 @@
my @hierarchy;
$hierarchy[0]=0;
my $hloc=0;
-my $token;
+my $token='';
$parser = HTML::TokeParser->new(\$parsestring) or
die('can\'t create TokeParser object');
$parser->xml_mode('1');
@@ -244,7 +249,7 @@
my @configall;
# Make new parser with distribution specific input
-undef $parser;
+undef($parser);
$parser = HTML::TokeParser->new(\$cleanstring) or
die('can\'t create TokeParser object');
$parser->xml_mode('1');
@@ -274,21 +279,21 @@
my $text;
my $token;
-undef $hloc;
-undef @hierarchy;
+undef($hloc);
+undef(@hierarchy);
my $hloc;
my @hierarchy2;
while ($token = $parser->get_tag('piml')) {
&format_piml(@{$token});
$text = &trim($parser->get_text('/piml'));
$token = $parser->get_tag('/piml');
- print $piml;
- print "\n";
- print $text;
- print "\n";
- print &end();
+ print($piml);
+ print("\n");
+ print($text);
+ print("\n");
+ print(&end());
}
-exit;
+exit(0);
# ---------- Functions (most all just format contents of different markup tags)
@@ -320,7 +325,7 @@
my $text=&trim($parser->get_text('/targetroot'));
$text=$targetroot if $targetroot;
$parser->get_tag('/targetroot');
- return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
+ return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n");
}
# -------------------------------------------------- Format perl script section
sub format_perlscript {
@@ -329,29 +334,29 @@
my $text=$parser->get_text('/perlscript');
$parser->get_tag('/perlscript');
if ($mode eq 'bg') {
- open OUT,">/tmp/piml$$.pl";
- print OUT $text;
- close OUT;
- return <<END;
+ open(OUT,">/tmp/piml$$.pl");
+ print(OUT $text);
+ close(OUT);
+ return(<<END);
# launch background process for $target
system("perl /tmp/piml$$.pl &");
END
}
else {
- return $text;
+ return($text);
}
}
# --------------------------------------------------------------- Format TARGET
sub format_TARGET {
my (@tokeninfo)=@_;
$parser->get_tag('/TARGET');
- return $target;
+ return($target);
}
# --------------------------------------------------- Format categories section
sub format_categories {
my $text=&trim($parser->get_text('/categories'));
$parser->get_tag('/categories');
- return '# CATEGORIES'."\n".$text;
+ return('# CATEGORIES'."\n".$text);
}
# --------------------------------------------------- Format categories section
sub format_category {
@@ -367,7 +372,7 @@
$categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
' -m '.$chmod;
}
- return '';
+ return('');
}
# --------------------------------------------------- Format categories section
sub format_abbreviation {
@@ -378,7 +383,7 @@
$parser->get_tag('/abbreviation');
$abbreviation=$text;
}
- return '';
+ return('');
}
# -------------------------------------------------------- Format chown section
sub format_chown {
@@ -389,7 +394,7 @@
$parser->get_tag('/chown');
$chown=$text;
}
- return '';
+ return('');
}
# -------------------------------------------------------- Format chmod section
sub format_chmod {
@@ -400,7 +405,7 @@
$parser->get_tag('/chmod');
$chmod=$text;
}
- return '';
+ return('');
}
# ------------------------------------------------- Format categoryname section
sub format_categoryname {
@@ -411,14 +416,14 @@
$parser->get_tag('/categoryname');
$categoryname=$text;
}
- return '';
+ return('');
}
# -------------------------------------------------------- Format files section
sub format_files {
my $text=$parser->get_text('/files');
$parser->get_tag('/files');
- return "\n".'# There are '.$file_count.' files this script works on'.
- "\n\n".$text;
+ return("\n".'# There are '.$file_count.' files this script works on'.
+ "\n\n".$text);
}
# --------------------------------------------------------- Format file section
sub format_file {
@@ -429,9 +434,8 @@
$file_count++;
$categorycount{$categoryname}++;
$parser->get_tag('/file');
- return "# File: $target\n".
- "$text\n";
- return '';
+ return("# File: $target\n".
+ "$text\n");
}
# ------------------------------------------------------- Format target section
sub format_target {
@@ -442,7 +446,7 @@
$parser->get_tag('/target');
$target=$targetrootarg.$text;
}
- return '';
+ return('');
}
# --------------------------------------------------------- Format note section
sub format_note {
@@ -467,8 +471,7 @@
if ($text) {
$note=$text;
}
- return '';
-
+ return('');
}
# ------------------------------------------------- Format dependencies section
sub format_dependencies {
@@ -480,32 +483,34 @@
$dependencies=join(';',
(map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
}
- return '';
+ return('');
}
# ------------------------------------------------ Format specialnotice section
sub format_specialnotices {
$parser->get_tag('/specialnotices');
- return '';
+ return('');
}
# ------------------------------------------------ Format specialnotice section
sub format_specialnotice {
$parser->get_tag('/specialnotice');
- return '';
+ return('');
}
# ------------------------------------- Render less-than and greater-than signs
sub htmlsafe {
my $text=@_[0];
$text =~ s/</</g;
$text =~ s/>/>/g;
- return $text;
+ return($text);
}
# --------------------------------------- remove starting and ending whitespace
sub trim {
- my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;
-}
+ my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return($s);
+}
# ----------------------------------- POD (plain old documentation, CPAN style)
+=pod
+
=head1 NAME
piml_parse.pl - This is meant to parse files meeting the piml document type.
@@ -564,5 +569,13 @@
=head1 SCRIPT CATEGORIES
Packaging/Administrative
+
+=head1 AUTHOR
+
+ Scott Harrison
+ codeharrison@yahoo.com
+
+Please let me know how/if you are finding this script useful and
+any/all suggestions. -Scott
=cut