Return to parse.pl CVS log

Up to [LON-CAPA] / loncom / build

update description of directory block.  also improve file highlighting
logic when not found in CVS source -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'}}{uc($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_file_type_ownership_and_permissions_description_block;
   98:     print $a;
   99:     $a=&make_directory_and_file_structure_description_block(\@directories);
  100:     print $a;
  101:     $a=&end_description_page;
  102:     print $a;
  103: }
  104: 
  105: # ------------------------------------------------- Begin description page
  106: sub begin_description_page {
  107:     my $description=<<END;
  108: <HTML>
  109: <HEAD>
  110: <TITLE>LON-CAPA Software Description Page ($distribution, $date)</TITLE>
  111: </HEAD>
  112: <BODY>
  113: <FONT SIZE=+2>LON-CAPA Software Description Page ($distribution, $date)</FONT>
  114: <BR>Michigan State University
  115: <BR>Learning Online with CAPA
  116: <BR>Contact korte\@lon-capa.org
  117: <UL>
  118: <LI>About this file
  119: <LI>Software Package Description
  120: <LI>Directory Structure
  121: <LI>File Type Ownership and Permissions
  122: <LI>File and Directory Structure
  123: </UL>
  124: <FONT SIZE=+2>About this file</FONT>
  125: <P>
  126: This file is generated dynamically by <TT>parse.pl</TT> as
  127: part of a development compilation process.  See 
  128: http://install.lon-capa.org/compile/index.html for more
  129: information.
  130: </P>
  131: END
  132:     return $description;
  133: }
  134: 
  135: # ------------------------------------------------- End description page
  136: sub end_description_page {
  137:     my $description=<<END;
  138: <HR>
  139: <FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
  140: </BODY>
  141: </HTML>
  142: END
  143:     return $description;
  144: }
  145: 
  146: # ------------------------------------------------- Make RPM description block
  147: sub make_rpm_description_block {
  148:     my $description=<<END;
  149: <FONT SIZE=+2>Rolled in a RedHat 6.2 RPM, $date</FONT>
  150: <P>
  151: <TABLE BGCOLOR=#FFFFFF BORDER=0 CELLPADDING=10 CELLSPACING=0>
  152: <TR><TD>
  153: <PRE>
  154: Name        : $info{'RPM'}{'Name'}
  155: Version     : $info{'RPM'}{'Version'}
  156: Vendor      : $info{'RPM'}{'Vendor'} 
  157: Release     : $info{'RPM'}{'Release'}                             
  158: Build Host  : $buildhost
  159: Group       : $info{'RPM'}{'Group'}
  160: License     : $info{'RPM'}{'Copyright'}
  161: Summary     : $info{'RPM'}{'Summary'}
  162: Description : 
  163: <PRE>
  164: $info{'RPM'}{'description'}
  165: </PRE>
  166: </TD></TR>
  167: </TABLE>
  168: </P>
  169: END
  170:     return $description;
  171: }
  172: 
  173: # ----------------------------------------------- Determine directory structure
  174: sub determine_directory_structure {
  175:     my @directories=keys %{$info{'DIRECTORY'}{$distribution}};
  176:     return (sort @directories);
  177: }
  178: 
  179: 
  180: # ---------------------------------- Make directory structure description block
  181: sub make_directory_structure_description_block {
  182:     my ($dirs)=@_;
  183:     my $description=<<END;
  184: <FONT SIZE=+2>Directory Structure Description, $date</FONT>
  185: <P>
  186: The directory structure description below shows only those
  187: directories which either contain LON-CAPA specific files
  188: or normally do not exist on a RedHat Linux system (and
  189: must be generated to allow proper placement of files
  190: during LON-CAPA run-time operation).
  191: </P>
  192: <P>
  193: <TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0>
  194: END
  195:     my $maxcount=0;
  196:     my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
  197:     my %diraccount; # hash to track which directories are accounted for
  198:     foreach my $file (@allfiles) {
  199: 	$file=~/^(.*)\/([^\/]+)$/;
  200: 	$diraccount{$1}=1;
  201:     }
  202:     foreach my $d (@$dirs) {
  203:         my (@matches)=($d=~/\//g);
  204: 	my $count=scalar(@matches);
  205: 	$maxcount=$count if $count>$maxcount;
  206: 	delete $diraccount{$d};
  207:     }
  208:     $description.=<<END;
  209: <TR>
  210: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Category</TH>
  211: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
  212: <TH ALIGN=LEFT BGCOLOR=#FFFFFF><FONT COLOR=#FF0000>Development<BR>Permissions</FONT></TH>
  213: END
  214:     $description.="<TH ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+1).">Directory Path</TH>\n";
  215:     if (keys %diraccount) {
  216: 	$description.= "<TR><TD ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+4)."><I><PRE>Directories that are unaccounted for: \n";
  217: 	foreach my $d (keys %diraccount) {
  218: 	    $description.="$d\n";
  219: 	}
  220: 	$description.="</PRE></I></TH></TR>\n";
  221:     }
  222:     foreach my $d (@$dirs) {
  223: 	my $dtable=$d;
  224: 	$dtable=~s/\//\<\/TD\>\<TD\>/g;
  225: 	my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'};
  226: 	my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'};
  227: 	my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'};
  228: 	my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'};
  229: 	my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'};
  230: 	$description.=<<END;
  231: <TR>
  232: <TD BGCOLOR=#FFFFFF>$category</TD>
  233: <TD BGCOLOR=#FFFFFF><TT>$chmod $chown</TT></TD>
  234: <TD BGCOLOR=#FFFFFF><FONT COLOR=#FF0000><TT>$devchmod $devchown</TT></FONT></TD>
  235: <TD>
  236: $dtable
  237: </TD>
  238: </TR>
  239: END
  240:     }
  241:     $description.=<<END;
  242: </TABLE>
  243: </P>
  244: END
  245:     return $description;
  246: }
  247: 
  248: # ------------------- Make file type ownership and permissions description block
  249: sub make_file_type_ownership_and_permissions_description_block {
  250:     my $description=<<END;
  251: <FONT SIZE=+2>File Type Ownership and Permissions Descriptions, $date</FONT>
  252: <P>
  253: This table shows what permissions and ownership settings correspond
  254: to each kind of file type.
  255: </P>
  256: <P>
  257: <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
  258: <TR>
  259: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Icon</TH>
  260: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Type</TH>
  261: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
  262: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH>
  263: </TR>
  264: END
  265:     foreach my $type (keys %{$info{'OWNERSHIP'}}) {
  266: 	if (defined($fcm{$type})) {
  267: 	    my $chmod=$info{'OWNERSHIP'}{$type}{'CHMOD'};
  268: 	    my $chown=$info{'OWNERSHIP'}{$type}{'CHOWN'};
  269: 	    my $devchmod=$info{'DEVOWNERSHIP'}{$type}{'CHMOD'};
  270: 	    my $devchown=$info{'DEVOWNERSHIP'}{$type}{'CHOWN'};
  271: 	    $description.=<<END;
  272: <TR>
  273: <TD><IMG SRC="$fcm{$type}.gif" ALT="$type"></TD>
  274: <TD>$type</TD>
  275: <TD><TT>$chmod $chown</TT></TD>
  276: <TD><TT>$devchmod $devchown</TT></TD>
  277: </TR>
  278: END
  279:         }
  280:     }
  281:     $description.=<<END;
  282: </TABLE>
  283: </P>
  284: END
  285: }
  286: 
  287: # ------------------------- Make directory and file structure description block
  288: sub make_directory_and_file_structure_description_block {
  289:     my ($dirs)=@_;
  290:     my $description=<<END;
  291: <FONT SIZE=+2>Directory and File Structure Description, $date</FONT>
  292: <P>
  293: The icons on the left column correspond to the file type
  294: specified in the second column.  The last column "Notes" shows compilation,
  295: dependency, and configuration information.  The CVS location
  296: shows the location of the binary source file (if applicable) needed to
  297: be copied to the target.  If the binary source file is not at
  298: the specified location, then the text is shown in 
  299: <FONT COLOR=#FF0000>red</FONT>.
  300: </P>
  301: <P>
  302: <TABLE BORDER=1 CELLPADDING=5 WIDTH=500>
  303: END
  304:     my $counter=0;
  305:     my @colorindex=("#80FF80","#80FFFF","#FFFF80");
  306:     my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
  307:     foreach my $d (@$dirs) {
  308: 	# set color
  309: 	my $color=$colorindex[$counter%3];
  310: 	# set other values
  311: 	my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'};
  312: 	$dirdescription="(" . $dirdescription . ")" if $dirdescription;
  313: 	# find subdirectories that are contained in this directory
  314: 	my @subdirs;
  315: 	foreach my $d2 (@$dirs) {
  316: 	    if ($d2=~/^$d\/([^\/]+)$/) {
  317: 		push @subdirs,$1;
  318: 	    }
  319: 	}
  320: 	# find files that are contained in this directory
  321: 	my @files;
  322: 	my @filesfull;
  323: 	foreach my $f (@allfiles) {
  324: 	    if ($f=~/^$d\/([^\/]+)$/) {
  325: 		push @files,$1;
  326: 		push @filesfull,$f;
  327: 	    }
  328: 	}
  329: 	# render starting HTML formatting elements
  330: 	if (@subdirs || @files) {
  331: 	    my $subdirstring="<BR>* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs;
  332: 	    $description.=<<END;
  333: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
  334: $subdirstring</FONT></TD></TR>
  335: END
  336:         }
  337: 	else {
  338: 	    $description.=<<END;
  339: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD></TR>
  340: END
  341:         }
  342: 	if (@files) {
  343: 	    $description.=<<END;
  344: <TR>
  345: <TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH>
  346: <TH BGCOLOR=$color ALIGN=LEFT>File Name</TH>
  347: <TH BGCOLOR=$color ALIGN=LEFT>Function</TH>
  348: <TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH>
  349: <TH BGCOLOR=$color ALIGN=LEFT>Notes</TH>
  350: </TR>
  351: END
  352:             foreach my $i (0..$#files) {
  353: 		my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'};
  354: 		my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'};
  355: 		my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'};
  356: 		my $note=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'NOTE'};
  357: 		$note.="<BR>" if $note;
  358: 		my $listing=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'FILES'};
  359: 		my @E=split(/\s+/,$listing);
  360: 		$source=~/(.*)\/[^\/]+$/;
  361: 		my $sd=$1;
  362: 		my $eflag=0;
  363: 		foreach my $e (@E) {
  364: 		    unless (-e "../../$sd/$e") {
  365: 			$e="<FONT COLOR=#FF0000>$e</FONT>";
  366: 			$eflag=1;
  367: 		    }
  368: 		}
  369: 		$listing=join("\n",@E);
  370: 		$listing="<B>listing</B><BR><FONT SIZE=-2>$listing</FONT>" if $listing;
  371: 		$listing.="<BR>" if $listing;
  372: 		my $build=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'BUILD'};
  373: 		$build="<B>build</B><BR>$build" if $build;
  374: 		$build.="<BR>" if $build;
  375: 		my $dependencies=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DEPENDENCIES'};
  376: 		$dependencies="<B>dependencies</B><BR>$dependencies" if $dependencies;
  377: 		$dependencies.="<BR>" if $dependencies;
  378: 		unless (-e "../../$source") {
  379: 		    $source=~/([^\/]+)$/;
  380: 		    my $s=$1;
  381: 		    if ($source!~/\*/) {
  382: 			$source="<FONT COLOR=#FF0000>$source</FONT>";
  383: 		    }
  384: 		    elsif ($eflag) {
  385: 			$source="<FONT COLOR=#FF0000>$source</FONT>";
  386: 		    }
  387: 		}
  388: 		$description.=<<END;
  389: <TR>
  390: <TD BGCOLOR=#A0A0A0><IMG SRC="$fcm{$category}.gif" ALT="$category"></TD>
  391: <TD BGCOLOR=$color>$category</TD>
  392: <TD BGCOLOR=$color>$files[$i]</TD>
  393: <TD BGCOLOR=$color>$fdescription&nbsp;</TD>
  394: <TD BGCOLOR=$color>$source</TD>
  395: <TD BGCOLOR=$color>$note$listing$build$dependencies&nbsp;</TD>
  396: </TR>
  397: END
  398: 	    }
  399: 	}
  400: 	$counter++;
  401:     }
  402:     $description.=<<END;
  403: </TABLE>
  404: </P>
  405: END
  406:     return $description;
  407: }