Diff for /loncom/build/Attic/parse.pl between versions 1.4 and 1.6

version 1.4, 2000/12/08 20:28:57 version 1.6, 2000/12/09 19:29:16
Line 12  my ($file,$mode)=@ARGV; Line 12  my ($file,$mode)=@ARGV;
 open IN,"<$file";  open IN,"<$file";
 my @lines=<IN>;  my @lines=<IN>;
 close IN;  close IN;
 my $info=join('',@lines);  my $info1=join('',@lines);
 my $info2=$info; # value to allow for meta data group retrieval  my $info2=$info1; # value to allow for meta data group retrieval
   
 # ------------------------------------------------------- Make default settings  # ------------------------------------------------------- Make default settings
 my $distribution="redhat6.2";  my $distribution="redhat6.2";
 my $date=`date +'%B %e, %Y'`; chop $date;  my $date=`date +'%B %e, %Y'`; chop $date;
 my $buildhost=`hostname`; chop $buildhost;  my $buildhost=`hostname`; chop $buildhost;
   # file category mappings
   my %fcm=(
    'conf' => 'configurable',
    'graphic file' => 'graphicfile',
    'handler' => 'handler',
    'interface file' => 'interfacefile',
    'symbolic link' => 'link',
    'root script' => 'rootscript',
    'script' => 'script',
    'setuid script' => 'setuid',
    'static conf' => 'static',
    'system file' => 'systemfile',
    );
   
 # ---------------------------------------------------- Parse the marked up data  # ---------------------------------------------------- Parse the marked up data
 my %info; # big data storage object  my %info; # big data storage object
 while ($info=~/\<loncapa\s+(.*?)\>/isg) {  while ($info1=~/\<loncapa\s+(.*?)\>/isg) {
     my $keystring=$1;      my $keystring=$1;
     # In the parsing of LON-CAPA tags, remove boundary white-space,      # In the parsing of LON-CAPA tags, remove boundary white-space,
     # and handle quotation commands.      # and handle quotation commands.
Line 31  while ($info=~/\<loncapa\s+(.*?)\>/isg) Line 44  while ($info=~/\<loncapa\s+(.*?)\>/isg)
     $value=~s/"$//;      $value=~s/"$//;
                                    (uc($key),$value);}                                     (uc($key),$value);}
              split(/\s+(?=\w+\s*\=)/,$keystring);               split(/\s+(?=\w+\s*\=)/,$keystring);
   
     # Handle the different types of commands      # Handle the different types of commands
     if (uc($hash{'TYPE'}) eq "OWNERSHIP") {      if (uc($hash{'TYPE'}) eq "OWNERSHIP") {
         $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHMOD'}=$hash{'CHMOD'};          $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHMOD'}=$hash{'CHMOD'};
Line 52  while ($info=~/\<loncapa\s+(.*?)\>/isg) Line 64  while ($info=~/\<loncapa\s+(.*?)\>/isg)
                                $hash{'DESCRIPTION'} if $hash{'DESCRIPTION'};                                 $hash{'DESCRIPTION'} if $hash{'DESCRIPTION'};
     }      }
     elsif (uc($hash{'TYPE'}) eq "LOCATION") {      elsif (uc($hash{'TYPE'}) eq "LOCATION") {
         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}=          $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}=                               $hash{'CATEGORY'};
                                                        $hash{'CATEGORY'};          $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'SOURCE'}=                                               $hash{'SOURCE'};
         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'SOURCE'}=  
                                                         $hash{'SOURCE'};  
         # get surrounding metagroup information          # get surrounding metagroup information
         my $ckeystring=$keystring; $ckeystring=~s/(SOURCE\=\"[^"]*)\*/$1\\\*/g;          my $ckeystring=$keystring; $ckeystring=~s/(SOURCE\=\"[^"]*)\*/$1\\\*/g;
           $ckeystring=~s/(TARGET\=\"[^"]*)\*/$1\\\*/g;
         $info2=~/.*\<(?:metagroup|metasupergroup)\>(.*?)\<loncapa\s+$ckeystring\>(.*?)\<\/(?:metagroup|metasupergroup)\>/is;          $info2=~/.*\<(?:metagroup|metasupergroup)\>(.*?)\<loncapa\s+$ckeystring\>(.*?)\<\/(?:metagroup|metasupergroup)\>/is;
  my $data=$1.$2;   my $data=$1.$2;
         my @meta=('description','build','dependencies','files','note');          my @meta=('description','build','dependencies','files','note');
Line 83  if ($mode eq "ALL" || $mode eq "HTML") { Line 94  if ($mode eq "ALL" || $mode eq "HTML") {
     @directories=&determine_directory_structure;      @directories=&determine_directory_structure;
     $a=&make_directory_structure_description_block(\@directories);      $a=&make_directory_structure_description_block(\@directories);
     print $a;      print $a;
       $a=&make_file_type_ownership_and_permissions_description_block;
       print $a;
     $a=&make_directory_and_file_structure_description_block(\@directories);      $a=&make_directory_and_file_structure_description_block(\@directories);
     print $a;      print $a;
     $a=&end_description_page;      $a=&end_description_page;
Line 122  END Line 135  END
 sub end_description_page {  sub end_description_page {
     my $description=<<END;      my $description=<<END;
 <HR>  <HR>
 <FONT SIZE=-2>LON-CAPA Software Development Team</FONT>  <FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
 </BODY>  </BODY>
 </HTML>  </HTML>
 END  END
Line 210  END Line 223  END
     return $description;      return $description;
 }  }
   
   # ------------------- Make file type ownership and permissions description block
   sub make_file_type_ownership_and_permissions_description_block {
       my $description=<<END;
   <FONT SIZE=+2>File Type Ownership and Permissions Descriptions, $date</FONT>
   <P>
   This table shows what permissions and ownership settings correspond
   to each kind of file type.
   </P>
   <P>
   <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
   <TR>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Icon</TH>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Type</TH>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH>
   </TR>
   END
       foreach my $type (keys %{$info{'OWNERSHIP'}}) {
    if (defined($fcm{$type})) {
       my $chmod=$info{'OWNERSHIP'}{$type}{'CHMOD'};
       my $chown=$info{'OWNERSHIP'}{$type}{'CHOWN'};
       my $devchmod=$info{'DEVOWNERSHIP'}{$type}{'CHMOD'};
       my $devchown=$info{'DEVOWNERSHIP'}{$type}{'CHOWN'};
       $description.=<<END;
   <TR>
   <TD><IMG SRC="$fcm{$type}.gif" ALT="$type"></TD>
   <TD>$type</TD>
   <TD><TT>$chmod $chown</TT></TD>
   <TD><TT>$devchmod $devchown</TT></TD>
   </TR>
   END
           }
       }
       $description.=<<END;
   </TABLE>
   </P>
   END
   }
   
 # ------------------------- Make directory and file structure description block  # ------------------------- Make directory and file structure description block
 sub make_directory_and_file_structure_description_block {  sub make_directory_and_file_structure_description_block {
     my ($dirs)=@_;      my ($dirs)=@_;
     my $description=<<END;      my $description=<<END;
 <FONT SIZE=+2>Directory and File Structure Description, $date</FONT>  <FONT SIZE=+2>Directory and File Structure Description, $date</FONT>
 <P>  <P>
 <TABLE BORDER=1 CELLPADDING=5>  The icons on the left column correspond to the file type
   specified in the second column.  The last column "Notes" shows compilation,
   dependency, and configuration information.
   </P>
   <P>
   <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
 END  END
     my $counter=0;      my $counter=0;
     my @colorindex=("#80FF80","#80FFFF","#FFFF80");      my @colorindex=("#80FF80","#80FFFF","#FFFF80");
     my @allfiles=keys %{$info{'LOCATION'}{$distribution}{'TARGET'}};      my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
     foreach my $d (@$dirs) {      foreach my $d (@$dirs) {
  # set color   # set color
  my $color=$colorindex[$counter%3];   my $color=$colorindex[$counter%3];
Line 230  END Line 287  END
  # find subdirectories that are contained in this directory   # find subdirectories that are contained in this directory
  my @subdirs;   my @subdirs;
  foreach my $d2 (@$dirs) {   foreach my $d2 (@$dirs) {
     if ($d2=~/$d\/([^\/]+)/) {      if ($d2=~/^$d\/([^\/]+)$/) {
  push @subdirs,$1;   push @subdirs,$1;
     }      }
  }   }
  # find files that are contained in this directory   # find files that are contained in this directory
  my @files;   my @files;
    my @filesfull;
  foreach my $f (@allfiles) {   foreach my $f (@allfiles) {
     if ($file=~/$d\/(.+)/) {      if ($f=~/^$d\/([^\/]+)$/) {
  push @files,$1;   push @files,$1;
    push @filesfull,$f;
     }      }
  }   }
  # render starting HTML formatting elements   # render starting HTML formatting elements
  if (@subdirs || @files) {   if (@subdirs || @files) {
     my $subdirstring="<BR>* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs;      my $subdirstring="<BR>* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs;
     $description.=<<END;      $description.=<<END;
 <TR><TD BGCOLOR=#000000 COLSPAN=5><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription  <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
 $subdirstring</FONT></TD><TD>  $subdirstring</FONT></TD></TR>
 END  END
         }          }
  else {   else {
     $description.=<<END;      $description.=<<END;
 <TR><TD BGCOLOR=#000000 COLSPAN=5><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD>  <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD></TR>
 END  END
         }          }
  if (@files) {   if (@files) {
     $description.=<<END;      $description.=<<END;
 <TR>  <TR>
 <TH ALIGN=LEFT>Type</TH>  <TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH>
 <TH ALIGN=LEFT>File Name</TH>  <TH BGCOLOR=$color ALIGN=LEFT>File Name</TH>
 <TH ALIGN=LEFT>Function</TH>  <TH BGCOLOR=$color ALIGN=LEFT>Function</TH>
 <TH ALIGN=LEFT>Notes</TH>  <TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH>
   <TH BGCOLOR=$color ALIGN=LEFT>Notes</TH>
 </TR>  </TR>
 END  END
  }              foreach my $i (0..$#files) {
  $description.=<<END;   my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'};
    my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'};
    my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'};
    my $notes=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'NOTES'};
    $description.=<<END;
   <TR>
   <TD BGCOLOR=#A0A0A0><IMG SRC="$fcm{$category}.gif" ALT="$category"></TD>
   <TD BGCOLOR=$color>$category</TD>
   <TD BGCOLOR=$color>$files[$i]</TD>
   <TD BGCOLOR=$color>$fdescription&nbsp;</TD>
   <TD BGCOLOR=$color>$source</TD>
   <TD BGCOLOR=$color>$notes&nbsp;</TD>
 </TR>  </TR>
 END  END
       }
    }
  $counter++;   $counter++;
     }      }
     $description.=<<END;      $description.=<<END;

Removed from v.1.4  
changed lines
  Added in v.1.6


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