Return to parse.pl CVS log

Up to [LON-CAPA] / loncom / build

works to render HTML output now.  still need to improve algorithm for
notes column rendering.  also need to include error checking and
other kinds of output (system update, RPM generation, etc) -Scott

    1: #!/usr/bin/perl
    2: 
    3: # Scott Harrison
    4: # November 2000
    5: 
    6: # Read in loncapa tags and metagroup tags
    7: 
    8: # ---------------------------------------------- Read in command line arguments
    9: my ($file,$mode)=@ARGV;
   10: 
   11: # ---------------------------------------------------- Read in master data file
   12: open IN,"<$file";
   13: my @lines=<IN>;
   14: close IN;
   15: my $info1=join('',@lines);
   16: my $info2=$info1; # value to allow for meta data group retrieval
   17: 
   18: # ------------------------------------------------------- Make default settings
   19: my $distribution="redhat6.2";
   20: my $date=`date +'%B %e, %Y'`; chop $date;
   21: my $buildhost=`hostname`; chop $buildhost;
   22: # file category mappings
   23: my %fcm=(
   24: 	 'conf' => 'configurable',
   25: 	 'graphic file' => 'graphicfile',
   26: 	 'handler' => 'handler',
   27: 	 'interface file' => 'interfacefile',
   28: 	 'symbolic link' => 'link',
   29: 	 'root script' => 'rootscript',
   30: 	 'script' => 'script',
   31: 	 'setuid script' => 'setuid',
   32: 	 'static conf' => 'static',
   33: 	 'system file' => 'systemfile',
   34: 	 );
   35: 
   36: # ---------------------------------------------------- Parse the marked up data
   37: my %info; # big data storage object
   38: while ($info1=~/\<loncapa\s+(.*?)\>/isg) {
   39:     my $keystring=$1;
   40:     # In the parsing of LON-CAPA tags, remove boundary white-space,
   41:     # and handle quotation commands.
   42:     my %hash=map {my ($key,$value)=split(/\=(?!")|\=(?=\s*"[^"]*"[^"]*$)/);
   43:                                    $value=~s/^"//;
   44:  				   $value=~s/"$//;
   45:                                    (uc($key),$value);}
   46:              split(/\s+(?=\w+\s*\=)/,$keystring);
   47:     # Handle the different types of commands
   48:     if (uc($hash{'TYPE'}) eq "OWNERSHIP") {
   49:         $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHMOD'}=$hash{'CHMOD'};
   50:         $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHOWN'}=$hash{'CHOWN'};
   51:     }
   52:     elsif (uc($hash{'TYPE'}) eq "DEVOWNERSHIP") {
   53:         $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHMOD'}=$hash{'CHMOD'};
   54:         $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHOWN'}=$hash{'CHOWN'};
   55:     }
   56:     elsif (uc($hash{'TYPE'}) eq "RPM") {
   57:         $hash{'VALUE'}=~s/\\n/\n/g;
   58:         $info{$hash{'TYPE'}}{$hash{'NAME'}}=$hash{'VALUE'};
   59:     }
   60:     elsif (uc($hash{'TYPE'}) eq "DIRECTORY") {
   61:         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}=
   62:                                                        $hash{'CATEGORY'};
   63:         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'DESCRIPTION'}=
   64:                                $hash{'DESCRIPTION'} if $hash{'DESCRIPTION'};
   65:     }
   66:     elsif (uc($hash{'TYPE'}) eq "LOCATION") {
   67:         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}=                               $hash{'CATEGORY'};
   68:         $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'SOURCE'}=                                               $hash{'SOURCE'};
   69:         # get surrounding metagroup information
   70:         my $ckeystring=$keystring; $ckeystring=~s/(SOURCE\=\"[^"]*)\*/$1\\\*/g;
   71:         $ckeystring=~s/(TARGET\=\"[^"]*)\*/$1\\\*/g;
   72:         $info2=~/.*\<(?:metagroup|metasupergroup)\>(.*?)\<loncapa\s+$ckeystring\>(.*?)\<\/(?:metagroup|metasupergroup)\>/is;
   73: 	my $data=$1.$2;
   74:         my @meta=('description','build','dependencies','files','note');
   75:         foreach my $m (@meta) {
   76: 	    if ($data=~/\<($m)\>(.*?)\<\/$m\>/sgi) {
   77: 		my ($key,$value)=($1,$2);
   78: 		$info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{$key}=
   79: 		                                                    $value;
   80: 	    }
   81:         }
   82:     }
   83:     else {
   84:         warn("WARNING: this tag text will be ignored since it cannot be understood\n---> $keystring\n");
   85:     }
   86: }
   87: 
   88: if ($mode eq "ALL" || $mode eq "HTML") {
   89:     my $a;
   90:     $a=&begin_description_page;
   91:     print $a;
   92:     $a=&make_rpm_description_block;
   93:     print $a;
   94:     @directories=&determine_directory_structure;
   95:     $a=&make_directory_structure_description_block(\@directories);
   96:     print $a;
   97:     $a=&make_directory_and_file_structure_description_block(\@directories);
   98:     print $a;
   99:     $a=&end_description_page;
  100:     print $a;
  101: }
  102: 
  103: # ------------------------------------------------- Begin description page
  104: sub begin_description_page {
  105:     my $description=<<END;
  106: <HTML>
  107: <HEAD>
  108: <TITLE>LON-CAPA Software Description Page ($distribution, $date)</TITLE>
  109: </HEAD>
  110: <BODY>
  111: <FONT SIZE=+2>LON-CAPA Software Description Page ($distribution, $date)</FONT>
  112: <BR>Michigan State University
  113: <BR>Learning Online with CAPA
  114: <BR>Contact korte\@lon-capa.org
  115: <UL>
  116: <LI>About this file
  117: <LI>Software Package Description
  118: <LI>Directory Structure
  119: <LI>File and Directory Structure
  120: </UL>
  121: <FONT SIZE=+2>About this file</FONT>
  122: <P>
  123: This file is generated dynamically by <TT>parse.pl</TT> as
  124: part of a development compilation process.  See 
  125: http://install.lon-capa.org/compile/index.html for more
  126: information.
  127: </P>
  128: END
  129:     return $description;
  130: }
  131: 
  132: # ------------------------------------------------- End description page
  133: sub end_description_page {
  134:     my $description=<<END;
  135: <HR>
  136: <FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
  137: </BODY>
  138: </HTML>
  139: END
  140:     return $description;
  141: }
  142: 
  143: # ------------------------------------------------- Make RPM description block
  144: sub make_rpm_description_block {
  145:     my $description=<<END;
  146: <FONT SIZE=+2>Rolled in a RedHat 6.2 RPM, $date</FONT>
  147: <P>
  148: <TABLE BGCOLOR=#FFFFFF BORDER=0 CELLPADDING=10 CELLSPACING=0>
  149: <TR><TD>
  150: <PRE>
  151: Name        : $info{'RPM'}{'Name'}
  152: Version     : $info{'RPM'}{'Version'}
  153: Vendor      : $info{'RPM'}{'Vendor'} 
  154: Release     : $info{'RPM'}{'Release'}                             
  155: Build Host  : $buildhost
  156: Group       : $info{'RPM'}{'Group'}
  157: License     : $info{'RPM'}{'Copyright'}
  158: Summary     : $info{'RPM'}{'Summary'}
  159: Description : 
  160: <PRE>
  161: $info{'RPM'}{'description'}
  162: </PRE>
  163: </TD></TR>
  164: </TABLE>
  165: </P>
  166: END
  167:     return $description;
  168: }
  169: 
  170: # ----------------------------------------------- Determine directory structure
  171: sub determine_directory_structure {
  172:     my @directories=keys %{$info{'DIRECTORY'}{$distribution}};
  173:     return (sort @directories);
  174: }
  175: 
  176: 
  177: # ---------------------------------- Make directory structure description block
  178: sub make_directory_structure_description_block {
  179:     my ($dirs)=@_;
  180:     my $description=<<END;
  181: <FONT SIZE=+2>Directory Structure Description, $date</FONT>
  182: <P>
  183: <TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0>
  184: END
  185:     my $maxcount=0;
  186:     foreach my $d (@$dirs) {
  187:         my (@matches)=($d=~/\//g);
  188: 	my $count=scalar(@matches);
  189: 	$maxcount=$count if $count>$maxcount;
  190:     }
  191:     $description.=<<END;
  192: <TR>
  193: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Category</TH>
  194: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
  195: <TH ALIGN=LEFT BGCOLOR=#FFFFFF><FONT COLOR=#FF0000>Development<BR>Permissions</FONT></TH>
  196: END
  197:     $description.="<TH ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+1).">Directory Path</TH>\n";
  198:     foreach my $d (@$dirs) {
  199: 	my $dtable=$d;
  200: 	$dtable=~s/\//\<\/TD\>\<TD\>/g;
  201: 	my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'};
  202: 	my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'};
  203: 	my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'};
  204: 	my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'};
  205: 	my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'};
  206: 	$description.=<<END;
  207: <TR>
  208: <TD BGCOLOR=#FFFFFF>$category</TD>
  209: <TD BGCOLOR=#FFFFFF><TT>$chmod $chown</TT></TD>
  210: <TD BGCOLOR=#FFFFFF><FONT COLOR=#FF0000><TT>$devchmod $devchown</TT></FONT></TD>
  211: <TD>
  212: $dtable
  213: </TD>
  214: </TR>
  215: END
  216:     }
  217:     $description.=<<END;
  218: </TABLE>
  219: </P>
  220: END
  221:     return $description;
  222: }
  223: 
  224: # ------------------------- Make directory and file structure description block
  225: sub make_directory_and_file_structure_description_block {
  226:     my ($dirs)=@_;
  227:     my $description=<<END;
  228: <FONT SIZE=+2>Directory and File Structure Description, $date</FONT>
  229: <P>
  230: <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
  231: END
  232:     my $counter=0;
  233:     my @colorindex=("#80FF80","#80FFFF","#FFFF80");
  234:     my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
  235:     foreach my $d (@$dirs) {
  236: 	# set color
  237: 	my $color=$colorindex[$counter%3];
  238: 	# set other values
  239: 	my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'};
  240: 	$dirdescription="(" . $dirdescription . ")" if $dirdescription;
  241: 	# find subdirectories that are contained in this directory
  242: 	my @subdirs;
  243: 	foreach my $d2 (@$dirs) {
  244: 	    if ($d2=~/^$d\/([^\/]+)$/) {
  245: 		push @subdirs,$1;
  246: 	    }
  247: 	}
  248: 	# find files that are contained in this directory
  249: 	my @files;
  250: 	my @filesfull;
  251: 	foreach my $f (@allfiles) {
  252: 	    if ($f=~/^$d\/([^\/]+)$/) {
  253: 		push @files,$1;
  254: 		push @filesfull,$f;
  255: 	    }
  256: 	}
  257: 	# render starting HTML formatting elements
  258: 	if (@subdirs || @files) {
  259: 	    my $subdirstring="<BR>* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs;
  260: 	    $description.=<<END;
  261: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
  262: $subdirstring</FONT></TD></TR>
  263: END
  264:         }
  265: 	else {
  266: 	    $description.=<<END;
  267: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD></TR>
  268: END
  269:         }
  270: 	if (@files) {
  271: 	    $description.=<<END;
  272: <TR>
  273: <TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH>
  274: <TH BGCOLOR=$color ALIGN=LEFT>File Name</TH>
  275: <TH BGCOLOR=$color ALIGN=LEFT>Function</TH>
  276: <TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH>
  277: <TH BGCOLOR=$color ALIGN=LEFT>Notes</TH>
  278: </TR>
  279: END
  280:             foreach my $i (0..$#files) {
  281: 		my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'};
  282: 		my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'};
  283: 		my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'};
  284: 		my $notes=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'NOTES'};
  285: 		$description.=<<END;
  286: <TR>
  287: <TD BGCOLOR=#A0A0A0><IMG SRC="$fcm{$category}.gif" ALT="$category"></TD>
  288: <TD BGCOLOR=$color>$category</TD>
  289: <TD BGCOLOR=$color>$files[$i]</TD>
  290: <TD BGCOLOR=$color>$fdescription&nbsp;</TD>
  291: <TD BGCOLOR=$color>$source</TD>
  292: <TD BGCOLOR=$color>$notes&nbsp;</TD>
  293: </TR>
  294: END
  295: 	    }
  296: 	}
  297: 	$counter++;
  298:     }
  299:     $description.=<<END;
  300: </TABLE>
  301: </P>
  302: END
  303:     return $description;
  304: }