loncom/build/parse.pl - view

File: [LON-CAPA] / loncom / build / Attic / parse.pl
Revision 1.6: download - view: text, annotated - select for diffs
Sat Dec 9 19:29:16 2000 UTC (23 years, 5 months ago) by harris41
Branches: MAIN
CVS tags: HEAD

inserted HTML output to describe file permissions.. also some
category descriptionson the HTML output page... still fixing -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_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: LON-CAPA Software Description Page ($distribution, $date) 114: Michigan State University 115: Learning Online with CAPA 116: Contact korte\@lon-capa.org 117: <UL> 118: <LI>About this file 119: <LI>Software Package Description 120: <LI>Directory Structure 121: <LI>File and Directory Structure 122: </UL> 123: About this file 124: 125: This file is generated dynamically by <TT>parse.pl</TT> as 126: part of a development compilation process. See 127: http://install.lon-capa.org/compile/index.html for more 128: information. 129: 130: END 131: return $description; 132: } 133: 134: # ------------------------------------------------- End description page 135: sub end_description_page { 136: my $description=<<END; 137: <HR> 138: LON-CAPA Software Development Team 139: </BODY> 140: </HTML> 141: END 142: return $description; 143: } 144: 145: # ------------------------------------------------- Make RPM description block 146: sub make_rpm_description_block { 147: my $description=<<END; 148: Rolled in a RedHat 6.2 RPM, $date 149: 150: <TABLE BGCOLOR=#FFFFFF BORDER=0 CELLPADDING=10 CELLSPACING=0> 151: <TR><TD> 152: <PRE> 153: Name : $info{'RPM'}{'Name'} 154: Version : $info{'RPM'}{'Version'} 155: Vendor : $info{'RPM'}{'Vendor'} 156: Release : $info{'RPM'}{'Release'} 157: Build Host : $buildhost 158: Group : $info{'RPM'}{'Group'} 159: License : $info{'RPM'}{'Copyright'} 160: Summary : $info{'RPM'}{'Summary'} 161: Description : 162: <PRE> 163: $info{'RPM'}{'description'} 164: </PRE> 165: </TD></TR> 166: </TABLE> 167: 168: END 169: return $description; 170: } 171: 172: # ----------------------------------------------- Determine directory structure 173: sub determine_directory_structure { 174: my @directories=keys %{$info{'DIRECTORY'}{$distribution}}; 175: return (sort @directories); 176: } 177: 178: 179: # ---------------------------------- Make directory structure description block 180: sub make_directory_structure_description_block { 181: my ($dirs)=@_; 182: my $description=<<END; 183: Directory Structure Description, $date 184: 185: <TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0> 186: END 187: my $maxcount=0; 188: foreach my $d (@$dirs) { 189: my (@matches)=($d=~/\//g); 190: my $count=scalar(@matches); 191: $maxcount=$count if $count>$maxcount; 192: } 193: $description.=<<END; 194: <TR> 195: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Category</TH> 196: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH> 197: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH> 198: END 199: $description.="<TH ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+1).">Directory Path</TH>\n"; 200: foreach my $d (@$dirs) { 201: my $dtable=$d; 202: $dtable=~s/\//\<\/TD\>\<TD\>/g; 203: my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'}; 204: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 205: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 206: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 207: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 208: $description.=<<END; 209: <TR> 210: <TD BGCOLOR=#FFFFFF>$category</TD> 211: <TD BGCOLOR=#FFFFFF><TT>$chmod $chown</TT></TD> 212: <TD BGCOLOR=#FFFFFF><TT>$devchmod $devchown</TT></TD> 213: <TD> 214: $dtable 215: </TD> 216: </TR> 217: END 218: } 219: $description.=<<END; 220: </TABLE> 221: 222: END 223: return $description; 224: } 225: 226: # ------------------- Make file type ownership and permissions description block 227: sub make_file_type_ownership_and_permissions_description_block { 228: my $description=<<END; 229: File Type Ownership and Permissions Descriptions, $date 230: 231: This table shows what permissions and ownership settings correspond 232: to each kind of file type. 233: 234: 235: <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%> 236: <TR> 237: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Icon</TH> 238: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Type</TH> 239: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH> 240: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH> 241: </TR> 242: END 243: foreach my $type (keys %{$info{'OWNERSHIP'}}) { 244: if (defined($fcm{$type})) { 245: my $chmod=$info{'OWNERSHIP'}{$type}{'CHMOD'}; 246: my $chown=$info{'OWNERSHIP'}{$type}{'CHOWN'}; 247: my $devchmod=$info{'DEVOWNERSHIP'}{$type}{'CHMOD'}; 248: my $devchown=$info{'DEVOWNERSHIP'}{$type}{'CHOWN'}; 249: $description.=<<END; 250: <TR> 251: <TD><IMG SRC="$fcm{$type}.gif" ALT="$type"></TD> 252: <TD>$type</TD> 253: <TD><TT>$chmod $chown</TT></TD> 254: <TD><TT>$devchmod $devchown</TT></TD> 255: </TR> 256: END 257: } 258: } 259: $description.=<<END; 260: </TABLE> 261: 262: END 263: } 264: 265: # ------------------------- Make directory and file structure description block 266: sub make_directory_and_file_structure_description_block { 267: my ($dirs)=@_; 268: my $description=<<END; 269: Directory and File Structure Description, $date 270: 271: The icons on the left column correspond to the file type 272: specified in the second column. The last column "Notes" shows compilation, 273: dependency, and configuration information. 274: 275: 276: <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%> 277: END 278: my $counter=0; 279: my @colorindex=("#80FF80","#80FFFF","#FFFF80"); 280: my @allfiles=keys %{$info{'LOCATION'}{$distribution}}; 281: foreach my $d (@$dirs) { 282: # set color 283: my $color=$colorindex[$counter%3]; 284: # set other values 285: my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'}; 286: $dirdescription="(" . $dirdescription . ")" if $dirdescription; 287: # find subdirectories that are contained in this directory 288: my @subdirs; 289: foreach my $d2 (@$dirs) { 290: if ($d2=~/^$d\/([^\/]+)$/) { 291: push @subdirs,$1; 292: } 293: } 294: # find files that are contained in this directory 295: my @files; 296: my @filesfull; 297: foreach my $f (@allfiles) { 298: if ($f=~/^$d\/([^\/]+)$/) { 299: push @files,$1; 300: push @filesfull,$f; 301: } 302: } 303: # render starting HTML formatting elements 304: if (@subdirs || @files) { 305: my $subdirstring=" * Relevant subdirectories: " . join(", ",@subdirs) if @subdirs; 306: $description.=<<END; 307: <TR><TD BGCOLOR=#000000 COLSPAN=6><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription 308: $subdirstring</TD></TR> 309: END 310: } 311: else { 312: $description.=<<END; 313: <TR><TD BGCOLOR=#000000 COLSPAN=6><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</TD></TR> 314: END 315: } 316: if (@files) { 317: $description.=<<END; 318: <TR> 319: <TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH> 320: <TH BGCOLOR=$color ALIGN=LEFT>File Name</TH> 321: <TH BGCOLOR=$color ALIGN=LEFT>Function</TH> 322: <TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH> 323: <TH BGCOLOR=$color ALIGN=LEFT>Notes</TH> 324: </TR> 325: END 326: foreach my $i (0..$#files) { 327: my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'}; 328: my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'}; 329: my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'}; 330: my $notes=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'NOTES'}; 331: $description.=<<END; 332: <TR> 333: <TD BGCOLOR=#A0A0A0><IMG SRC="$fcm{$category}.gif" ALT="$category"></TD> 334: <TD BGCOLOR=$color>$category</TD> 335: <TD BGCOLOR=$color>$files[$i]</TD> 336: <TD BGCOLOR=$color>$fdescription </TD> 337: <TD BGCOLOR=$color>$source</TD> 338: <TD BGCOLOR=$color>$notes </TD> 339: </TR> 340: END 341: } 342: } 343: $counter++; 344: } 345: $description.=<<END; 346: </TABLE> 347: 348: END 349: return $description; 350: }