Annotation of loncom/build/parse.pl, revision 1.4

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

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