|
version 1.4, 2002/02/05 01:29:22
|
version 1.6, 2002/04/08 10:53:17
|
|
Line 1
|
Line 1
|
| #!/usr/bin/perl |
#!/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 |
# The LearningOnline Network with CAPA |
| # piml_parse.pl - Linux Packaging Markup Language parser |
# piml_parse.pl - Linux Packaging Markup Language parser |
| # |
# |
| # $Id$ |
# $Id$ |
| # |
# |
| # Written by Scott Harrison, harris41@msu.edu |
# Written by Scott Harrison, codeharrison@yahoo.com |
| # |
# |
| # Copyright Michigan State University Board of Trustees |
# Copyright Michigan State University Board of Trustees |
| # |
# |
|
Line 30
|
Line 35
|
| # http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
| # |
# |
| # YEAR=2002 |
# 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 |
| # |
# |
| ### |
### |
| |
|
|
Line 58
|
Line 63
|
| |
|
| use HTML::TokeParser; |
use HTML::TokeParser; |
| |
|
| my $usage=<<END; |
my $usage=(<<END); |
| **** ERROR ERROR ERROR ERROR **** |
**** ERROR ERROR ERROR ERROR **** |
| Usage is for piml file to come in through standard input. |
Usage is for piml file to come in through standard input. |
| 1st argument is the category permissions to use (runtime or development) |
1st argument is the category permissions to use (runtime or development) |
|
Line 120 END
|
Line 125 END
|
| # ---------------------------------------------------- Start first pass through |
# ---------------------------------------------------- Start first pass through |
| my @parsecontents = <>; |
my @parsecontents = <>; |
| my $parsestring = join('',@parsecontents); |
my $parsestring = join('',@parsecontents); |
| my $outstring; |
my $outstring=''; |
| |
|
| # Need to make a pass through and figure out what defaults are |
# Need to make a pass through and figure out what defaults are |
| # overrided. Top-down overriding strategy (leaves don't know |
# overrided. Top-down overriding strategy (leaves don't know |
|
Line 129 my $outstring;
|
Line 134 my $outstring;
|
| my @hierarchy; |
my @hierarchy; |
| $hierarchy[0]=0; |
$hierarchy[0]=0; |
| my $hloc=0; |
my $hloc=0; |
| my $token; |
my $token=''; |
| $parser = HTML::TokeParser->new(\$parsestring) or |
$parser = HTML::TokeParser->new(\$parsestring) or |
| die('can\'t create TokeParser object'); |
die('can\'t create TokeParser object'); |
| $parser->xml_mode('1'); |
$parser->xml_mode('1'); |
|
Line 244 my @buildinfo;
|
Line 249 my @buildinfo;
|
| my @configall; |
my @configall; |
| |
|
| # Make new parser with distribution specific input |
# Make new parser with distribution specific input |
| undef $parser; |
undef($parser); |
| $parser = HTML::TokeParser->new(\$cleanstring) or |
$parser = HTML::TokeParser->new(\$cleanstring) or |
| die('can\'t create TokeParser object'); |
die('can\'t create TokeParser object'); |
| $parser->xml_mode('1'); |
$parser->xml_mode('1'); |
|
Line 274 $parser->{textify}={
|
Line 279 $parser->{textify}={
|
| |
|
| my $text; |
my $text; |
| my $token; |
my $token; |
| undef $hloc; |
undef($hloc); |
| undef @hierarchy; |
undef(@hierarchy); |
| my $hloc; |
my $hloc; |
| my @hierarchy2; |
my @hierarchy2; |
| while ($token = $parser->get_tag('piml')) { |
while ($token = $parser->get_tag('piml')) { |
| &format_piml(@{$token}); |
&format_piml(@{$token}); |
| $text = &trim($parser->get_text('/piml')); |
$text = &trim($parser->get_text('/piml')); |
| $token = $parser->get_tag('/piml'); |
$token = $parser->get_tag('/piml'); |
| print $piml; |
print($piml); |
| print "\n"; |
print("\n"); |
| print $text; |
print($text); |
| print "\n"; |
print("\n"); |
| print &end(); |
print(&end()); |
| } |
} |
| exit; |
exit(0); |
| |
|
| # ---------- Functions (most all just format contents of different markup tags) |
# ---------- Functions (most all just format contents of different markup tags) |
| |
|
|
Line 320 sub format_targetroot {
|
Line 325 sub format_targetroot {
|
| my $text=&trim($parser->get_text('/targetroot')); |
my $text=&trim($parser->get_text('/targetroot')); |
| $text=$targetroot if $targetroot; |
$text=$targetroot if $targetroot; |
| $parser->get_tag('/targetroot'); |
$parser->get_tag('/targetroot'); |
| return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; |
return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"); |
| } |
} |
| # -------------------------------------------------- Format perl script section |
# -------------------------------------------------- Format perl script section |
| sub format_perlscript { |
sub format_perlscript { |
| my (@tokeninfo)=@_; |
my (@tokeninfo)=@_; |
| $mode=$tokeninfo->[2]{'mode'}; |
$mode=$tokeninfo[2]->{'mode'}; |
| my $text=$parser->get_text('/perlscript'); |
my $text=$parser->get_text('/perlscript'); |
| $parser->get_tag('/perlscript'); |
$parser->get_tag('/perlscript'); |
| return $text; |
if ($mode eq 'bg') { |
| |
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); |
| |
} |
| } |
} |
| # --------------------------------------------------------------- Format TARGET |
# --------------------------------------------------------------- Format TARGET |
| sub format_TARGET { |
sub format_TARGET { |
| my (@tokeninfo)=@_; |
my (@tokeninfo)=@_; |
| $parser->get_tag('/TARGET'); |
$parser->get_tag('/TARGET'); |
| return $target; |
return($target); |
| } |
} |
| # --------------------------------------------------- Format categories section |
# --------------------------------------------------- Format categories section |
| sub format_categories { |
sub format_categories { |
| my $text=&trim($parser->get_text('/categories')); |
my $text=&trim($parser->get_text('/categories')); |
| $parser->get_tag('/categories'); |
$parser->get_tag('/categories'); |
| return '# CATEGORIES'."\n".$text; |
return('# CATEGORIES'."\n".$text); |
| } |
} |
| # --------------------------------------------------- Format categories section |
# --------------------------------------------------- Format categories section |
| sub format_category { |
sub format_category { |
|
Line 356 sub format_category {
|
Line 372 sub format_category {
|
| $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. |
$categoryhash{$category_att_name}='-o '.$user.' -g '.$group. |
| ' -m '.$chmod; |
' -m '.$chmod; |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # --------------------------------------------------- Format categories section |
# --------------------------------------------------- Format categories section |
| sub format_abbreviation { |
sub format_abbreviation { |
|
Line 367 sub format_abbreviation {
|
Line 383 sub format_abbreviation {
|
| $parser->get_tag('/abbreviation'); |
$parser->get_tag('/abbreviation'); |
| $abbreviation=$text; |
$abbreviation=$text; |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # -------------------------------------------------------- Format chown section |
# -------------------------------------------------------- Format chown section |
| sub format_chown { |
sub format_chown { |
|
Line 378 sub format_chown {
|
Line 394 sub format_chown {
|
| $parser->get_tag('/chown'); |
$parser->get_tag('/chown'); |
| $chown=$text; |
$chown=$text; |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # -------------------------------------------------------- Format chmod section |
# -------------------------------------------------------- Format chmod section |
| sub format_chmod { |
sub format_chmod { |
|
Line 389 sub format_chmod {
|
Line 405 sub format_chmod {
|
| $parser->get_tag('/chmod'); |
$parser->get_tag('/chmod'); |
| $chmod=$text; |
$chmod=$text; |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # ------------------------------------------------- Format categoryname section |
# ------------------------------------------------- Format categoryname section |
| sub format_categoryname { |
sub format_categoryname { |
|
Line 400 sub format_categoryname {
|
Line 416 sub format_categoryname {
|
| $parser->get_tag('/categoryname'); |
$parser->get_tag('/categoryname'); |
| $categoryname=$text; |
$categoryname=$text; |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # -------------------------------------------------------- Format files section |
# -------------------------------------------------------- Format files section |
| sub format_files { |
sub format_files { |
| my $text=$parser->get_text('/files'); |
my $text=$parser->get_text('/files'); |
| $parser->get_tag('/files'); |
$parser->get_tag('/files'); |
| return "\n".'# There are '.$file_count.' files this script works on'. |
return("\n".'# There are '.$file_count.' files this script works on'. |
| "\n\n".$text; |
"\n\n".$text); |
| } |
} |
| # --------------------------------------------------------- Format file section |
# --------------------------------------------------------- Format file section |
| sub format_file { |
sub format_file { |
|
Line 418 sub format_file {
|
Line 434 sub format_file {
|
| $file_count++; |
$file_count++; |
| $categorycount{$categoryname}++; |
$categorycount{$categoryname}++; |
| $parser->get_tag('/file'); |
$parser->get_tag('/file'); |
| return "# File: $target\n". |
return("# File: $target\n". |
| "$text\n"; |
"$text\n"); |
| return ''; |
|
| } |
} |
| # ------------------------------------------------------- Format target section |
# ------------------------------------------------------- Format target section |
| sub format_target { |
sub format_target { |
|
Line 431 sub format_target {
|
Line 446 sub format_target {
|
| $parser->get_tag('/target'); |
$parser->get_tag('/target'); |
| $target=$targetrootarg.$text; |
$target=$targetrootarg.$text; |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # --------------------------------------------------------- Format note section |
# --------------------------------------------------------- Format note section |
| sub format_note { |
sub format_note { |
|
Line 456 sub format_note {
|
Line 471 sub format_note {
|
| if ($text) { |
if ($text) { |
| $note=$text; |
$note=$text; |
| } |
} |
| return ''; |
return(''); |
| |
|
| } |
} |
| # ------------------------------------------------- Format dependencies section |
# ------------------------------------------------- Format dependencies section |
| sub format_dependencies { |
sub format_dependencies { |
|
Line 469 sub format_dependencies {
|
Line 483 sub format_dependencies {
|
| $dependencies=join(';', |
$dependencies=join(';', |
| (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text))); |
(map {s/^\s*//;s/\s$//;$_} split(/\;/,$text))); |
| } |
} |
| return ''; |
return(''); |
| } |
} |
| # ------------------------------------------------ Format specialnotice section |
# ------------------------------------------------ Format specialnotice section |
| sub format_specialnotices { |
sub format_specialnotices { |
| $parser->get_tag('/specialnotices'); |
$parser->get_tag('/specialnotices'); |
| return ''; |
return(''); |
| } |
} |
| # ------------------------------------------------ Format specialnotice section |
# ------------------------------------------------ Format specialnotice section |
| sub format_specialnotice { |
sub format_specialnotice { |
| $parser->get_tag('/specialnotice'); |
$parser->get_tag('/specialnotice'); |
| return ''; |
return(''); |
| } |
} |
| # ------------------------------------- Render less-than and greater-than signs |
# ------------------------------------- Render less-than and greater-than signs |
| sub htmlsafe { |
sub htmlsafe { |
| my $text=@_[0]; |
my $text=@_[0]; |
| $text =~ s/</</g; |
$text =~ s/</</g; |
| $text =~ s/>/>/g; |
$text =~ s/>/>/g; |
| return $text; |
return($text); |
| } |
} |
| # --------------------------------------- remove starting and ending whitespace |
# --------------------------------------- remove starting and ending whitespace |
| sub trim { |
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 (plain old documentation, CPAN style) |
| |
|
| |
=pod |
| |
|
| =head1 NAME |
=head1 NAME |
| |
|
| piml_parse.pl - This is meant to parse files meeting the piml document type. |
piml_parse.pl - This is meant to parse files meeting the piml document type. |
|
Line 554 linux
|
Line 570 linux
|
| |
|
| Packaging/Administrative |
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 |
=cut |
![[BACK]](/icons/back.gif){kind=icon}
Return to piml_parse.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build