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

Diff for /loncom/build/Attic/parse.pl between versions 1.3 and 1.8

version 1.3, 2000/12/07 20:42:13 version 1.8, 2000/12/10 03:06:11
Line 5 Line 5
   
 # Read in loncapa tags and metagroup tags  # Read in loncapa tags and metagroup tags
   
 # -------------------------------------------- Read in command line arguments  # ---------------------------------------------- Read in command line arguments
 my ($file,$mode)=@ARGV;  my ($file,$mode)=@ARGV;
   
 # -------------------------------------------- Read in master data file  # ---------------------------------------------------- Read in master data file
 open IN,"<$file";  open IN,"<$file";
 my @lines=<IN>;  my @lines=<IN>;
 close IN;  close IN;
   my $info1=join('',@lines);
   my $info2=$info1; # value to allow for meta data group retrieval
   
 my $info=join('',@lines);  # ------------------------------------------------------- Make default settings
 my $info2=$info; # value to allow for meta data group retrieval  my $distribution="redhat6.2";
   my $date=`date +'%B %e, %Y'`; chop $date;
   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',
    );
   
 my %ihash; # big data storage object  # ---------------------------------------------------- Parse the marked up data
 while ($info=~/\<loncapa\s+(.*?)\>/isg) {  my %info; # big data storage object
   while ($info1=~/\<loncapa\s+(.*?)\>/isg) {
     my $keystring=$1;      my $keystring=$1;
       # In the parsing of LON-CAPA tags, remove boundary white-space,
       # and handle quotation commands.
     my %hash=map {my ($key,$value)=split(/\=(?!")|\=(?=\s*"[^"]*"[^"]*$)/);      my %hash=map {my ($key,$value)=split(/\=(?!")|\=(?=\s*"[^"]*"[^"]*$)/);
                                    $value=~s/^"//;                                     $value=~s/^"//;
     $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
     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'};
         $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHOWN'}=$hash{'CHOWN'};          $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHOWN'}=$hash{'CHOWN'};
Line 37  while ($info=~/\<loncapa\s+(.*?)\>/isg) Line 58  while ($info=~/\<loncapa\s+(.*?)\>/isg)
         $info{$hash{'TYPE'}}{$hash{'NAME'}}=$hash{'VALUE'};          $info{$hash{'TYPE'}}{$hash{'NAME'}}=$hash{'VALUE'};
     }      }
     elsif (uc($hash{'TYPE'}) eq "DIRECTORY") {      elsif (uc($hash{'TYPE'}) eq "DIRECTORY") {
         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}=$hash{'CATEGORY'};          $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}=
         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'DESCRIPTION'}=$hash{'DESCRIPTION'} if $hash{'DESCRIPTION'};                                                         $hash{'CATEGORY'};
           $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'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'}=$hash{'CATEGORY'};          $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'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');
         foreach my $m (@meta) {          foreach my $m (@meta) {
     if ($data=~/\<($m)\>(.*?)\<\/$m\>/sgi) {      if ($data=~/\<($m)\>(.*?)\<\/$m\>/sgi) {
  my ($key,$value)=($1,$2);   my ($key,$value)=($1,$2);
  $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{$key}=$value;   $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{$key}=
 # print "$key\n\n$value\n\n\n\n";                                                      $value;
     }      }
         }          }
     }      }
Line 61  while ($info=~/\<loncapa\s+(.*?)\>/isg) Line 85  while ($info=~/\<loncapa\s+(.*?)\>/isg)
     }      }
 }  }
   
   if ($mode eq "ALL" || $mode eq "HTML") {
       my $a;
       $a=&begin_description_page;
       print $a;
       $a=&make_rpm_description_block;
       print $a;
       @directories=&determine_directory_structure;
       $a=&make_directory_structure_description_block(\@directories);
       print $a;
       $a=&make_file_type_ownership_and_permissions_description_block;
       print $a;
       $a=&make_directory_and_file_structure_description_block(\@directories);
       print $a;
       $a=&end_description_page;
       print $a;
   }
   
   # ------------------------------------------------- Begin description page
   sub begin_description_page {
       my $description=<<END;
   <HTML>
   <HEAD>
   <TITLE>LON-CAPA Software Description Page ($distribution, $date)</TITLE>
   </HEAD>
   <BODY>
   <FONT SIZE=+2>LON-CAPA Software Description Page ($distribution, $date)</FONT>
   <BR>Michigan State University
   <BR>Learning Online with CAPA
   <BR>Contact korte\@lon-capa.org
   <UL>
   <LI>About this file
   <LI>Software Package Description
   <LI>Directory Structure
   <LI>File Type Ownership and Permissions
   <LI>File and Directory Structure
   </UL>
   <FONT SIZE=+2>About this file</FONT>
   <P>
   This file is generated dynamically by <TT>parse.pl</TT> as
   part of a development compilation process.  See 
   http://install.lon-capa.org/compile/index.html for more
   information.
   </P>
   END
       return $description;
   }
   
   # ------------------------------------------------- End description page
   sub end_description_page {
       my $description=<<END;
   <HR>
   <FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
   </BODY>
   </HTML>
   END
       return $description;
   }
   
   # ------------------------------------------------- Make RPM description block
   sub make_rpm_description_block {
       my $description=<<END;
   <FONT SIZE=+2>Rolled in a RedHat 6.2 RPM, $date</FONT>
   <P>
   <TABLE BGCOLOR=#FFFFFF BORDER=0 CELLPADDING=10 CELLSPACING=0>
   <TR><TD>
   <PRE>
   Name        : $info{'RPM'}{'Name'}
   Version     : $info{'RPM'}{'Version'}
   Vendor      : $info{'RPM'}{'Vendor'} 
   Release     : $info{'RPM'}{'Release'}                             
   Build Host  : $buildhost
   Group       : $info{'RPM'}{'Group'}
   License     : $info{'RPM'}{'Copyright'}
   Summary     : $info{'RPM'}{'Summary'}
   Description : 
   <PRE>
   $info{'RPM'}{'description'}
   </PRE>
   </TD></TR>
   </TABLE>
   </P>
   END
       return $description;
   }
   
   # ----------------------------------------------- Determine directory structure
   sub determine_directory_structure {
       my @directories=keys %{$info{'DIRECTORY'}{$distribution}};
       return (sort @directories);
   }
   
   
   # ---------------------------------- Make directory structure description block
   sub make_directory_structure_description_block {
       my ($dirs)=@_;
       my $description=<<END;
   <FONT SIZE=+2>Directory Structure Description, $date</FONT>
   <P>
   <TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0>
   END
       my $maxcount=0;
       my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
       my %diraccount; # hash to track which directories are accounted for
       foreach my $file (@allfiles) {
    $file=~/^(.*)\/([^\/]+)$/;
    $diraccount{$1}=1;
       }
       foreach my $d (@$dirs) {
           my (@matches)=($d=~/\//g);
    my $count=scalar(@matches);
    $maxcount=$count if $count>$maxcount;
    delete $diraccount{$d};
       }
       $description.=<<END;
   <TR>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Category</TH>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
   <TH ALIGN=LEFT BGCOLOR=#FFFFFF><FONT COLOR=#FF0000>Development<BR>Permissions</FONT></TH>
   END
       $description.="<TH ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+1).">Directory Path</TH>\n";
       if (keys %diraccount) {
    $description.= "<TR><TD ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+4)."><I><PRE>Directories that are unaccounted for: \n";
    foreach my $d (keys %diraccount) {
       $description.="$d\n";
    }
    $description.="</PRE></I></TH></TR>\n";
       }
       foreach my $d (@$dirs) {
    my $dtable=$d;
    $dtable=~s/\//\<\/TD\>\<TD\>/g;
    my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'};
    my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'};
    my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'};
    my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'};
    my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'};
    $description.=<<END;
   <TR>
   <TD BGCOLOR=#FFFFFF>$category</TD>
   <TD BGCOLOR=#FFFFFF><TT>$chmod $chown</TT></TD>
   <TD BGCOLOR=#FFFFFF><FONT COLOR=#FF0000><TT>$devchmod $devchown</TT></FONT></TD>
   <TD>
   $dtable
   </TD>
   </TR>
   END
       }
       $description.=<<END;
   </TABLE>
   </P>
   END
       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
   sub make_directory_and_file_structure_description_block {
       my ($dirs)=@_;
       my $description=<<END;
   <FONT SIZE=+2>Directory and File Structure Description, $date</FONT>
   <P>
   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.  The CVS location
   shows the location of the binary source file (if applicable) needed to
   be copied to the target.  If the binary source file is not at
   the specified location, then the text is shown in 
   <FONT COLOR=#FF0000>red</FONT>.
   </P>
   <P>
   <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
   END
       my $counter=0;
       my @colorindex=("#80FF80","#80FFFF","#FFFF80");
       my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
       foreach my $d (@$dirs) {
    # set color
    my $color=$colorindex[$counter%3];
    # set other values
    my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'};
    $dirdescription="(" . $dirdescription . ")" if $dirdescription;
    # find subdirectories that are contained in this directory
    my @subdirs;
    foreach my $d2 (@$dirs) {
       if ($d2=~/^$d\/([^\/]+)$/) {
    push @subdirs,$1;
       }
    }
    # find files that are contained in this directory
    my @files;
    my @filesfull;
    foreach my $f (@allfiles) {
       if ($f=~/^$d\/([^\/]+)$/) {
    push @files,$1;
    push @filesfull,$f;
       }
    }
    # render starting HTML formatting elements
    if (@subdirs || @files) {
       my $subdirstring="<BR>* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs;
       $description.=<<END;
   <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
   $subdirstring</FONT></TD></TR>
   END
           }
    else {
       $description.=<<END;
   <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD></TR>
   END
           }
    if (@files) {
       $description.=<<END;
   <TR>
   <TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH>
   <TH BGCOLOR=$color ALIGN=LEFT>File Name</TH>
   <TH BGCOLOR=$color ALIGN=LEFT>Function</TH>
   <TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH>
   <TH BGCOLOR=$color ALIGN=LEFT>Notes</TH>
   </TR>
   END
               foreach my $i (0..$#files) {
    my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'};
    my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'};
    my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'};
    unless (-e "../../$source") {
       $source=~/([^\/]+)$/;
       my $s=$1;
       $source="<FONT COLOR=#FF0000>$source</FONT>";
   #    my $fr=`cd ../../; find . -name $s`;
   #    $source.="<BR>$fr\n";
    }
    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>
   END
       }
    }
    $counter++;
       }
       $description.=<<END;
   </TABLE>
   </P>
   END
       return $description;
   }
Removed from v.1.3  
changed lines
  Added in v.1.8

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