[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.2 and 1.6

version 1.2, 2000/12/07 20:34:12 version 1.6, 2000/12/09 19:29:16
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 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;
       foreach my $d (@$dirs) {
           my (@matches)=($d=~/\//g);
    my $count=scalar(@matches);
    $maxcount=$count if $count>$maxcount;
       }
       $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";
       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.
   </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'};
    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.2  
changed lines
  Added in v.1.6

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