Annotation of loncom/build/parse.pl, revision 1.5
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;
1.5 ! harris41 15: my $info1=join('',@lines);
! 16: my $info2=$info1; # value to allow for meta data group retrieval
1.1 harris41 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;
1.5 ! harris41 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: );
1.4 harris41 35:
36: # ---------------------------------------------------- Parse the marked up data
37: my %info; # big data storage object
1.5 ! harris41 38: while ($info1=~/\<loncapa\s+(.*?)\>/isg) {
1.1 harris41 39: my $keystring=$1;
1.4 harris41 40: # In the parsing of LON-CAPA tags, remove boundary white-space,
41: # and handle quotation commands.
1.2 harris41 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);
1.4 harris41 47: # Handle the different types of commands
1.1 harris41 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") {
1.4 harris41 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'};
1.1 harris41 65: }
66: elsif (uc($hash{'TYPE'}) eq "LOCATION") {
1.5 ! harris41 67: $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}= $hash{'CATEGORY'};
! 68: $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'SOURCE'}= $hash{'SOURCE'};
1.1 harris41 69: # get surrounding metagroup information
70: my $ckeystring=$keystring; $ckeystring=~s/(SOURCE\=\"[^"]*)\*/$1\\\*/g;
1.5 ! harris41 71: $ckeystring=~s/(TARGET\=\"[^"]*)\*/$1\\\*/g;
1.1 harris41 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);
1.4 harris41 78: $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{$key}=
79: $value;
1.1 harris41 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:
1.4 harris41 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>
1.5 ! harris41 136: <FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
1.4 harris41 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: }
1.1 harris41 175:
1.4 harris41 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>
1.5 ! harris41 230: <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
1.4 harris41 231: END
232: my $counter=0;
233: my @colorindex=("#80FF80","#80FFFF","#FFFF80");
1.5 ! harris41 234: my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
1.4 harris41 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) {
1.5 ! harris41 244: if ($d2=~/^$d\/([^\/]+)$/) {
1.4 harris41 245: push @subdirs,$1;
246: }
247: }
248: # find files that are contained in this directory
249: my @files;
1.5 ! harris41 250: my @filesfull;
1.4 harris41 251: foreach my $f (@allfiles) {
1.5 ! harris41 252: if ($f=~/^$d\/([^\/]+)$/) {
1.4 harris41 253: push @files,$1;
1.5 ! harris41 254: push @filesfull,$f;
1.4 harris41 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;
1.5 ! harris41 261: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
! 262: $subdirstring</FONT></TD></TR>
1.4 harris41 263: END
264: }
265: else {
266: $description.=<<END;
1.5 ! harris41 267: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD></TR>
1.4 harris41 268: END
269: }
270: if (@files) {
271: $description.=<<END;
272: <TR>
1.5 ! harris41 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>
1.4 harris41 278: </TR>
279: END
1.5 ! harris41 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 </TD>
! 291: <TD BGCOLOR=$color>$source</TD>
! 292: <TD BGCOLOR=$color>$notes </TD>
1.4 harris41 293: </TR>
294: END
1.5 ! harris41 295: }
! 296: }
1.4 harris41 297: $counter++;
298: }
299: $description.=<<END;
300: </TABLE>
301: </P>
302: END
303: return $description;
304: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to parse.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build