[BACK]Return to piml_parse.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/piml_parse.pl between versions 1.5 and 1.6

version 1.5, 2002/02/05 01:49:39 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 {
Line 329  sub format_perlscript { Line 334  sub format_perlscript {
     my $text=$parser->get_text('/perlscript');      my $text=$parser->get_text('/perlscript');
     $parser->get_tag('/perlscript');      $parser->get_tag('/perlscript');
     if ($mode eq 'bg') {      if ($mode eq 'bg') {
  open OUT,">/tmp/piml$$.pl";   open(OUT,">/tmp/piml$$.pl");
  print OUT $text;   print(OUT $text);
  close OUT;   close(OUT);
  return <<END;   return(<<END);
  # launch background process for $target   # launch background process for $target
  system("perl /tmp/piml$$.pl &");   system("perl /tmp/piml$$.pl &");
 END  END
     }      }
     else {      else {
  return $text;   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 367  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 378  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 389  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 400  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 411  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 429  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 442  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 467  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 480  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/</&lt;/g;      $text =~ s/</&lt;/g;
     $text =~ s/>/&gt;/g;      $text =~ s/>/&gt;/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 565  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
Removed from v.1.5  
changed lines
  Added in v.1.6

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