Annotation of loncom/build/parse.pl, revision 1.9
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.9 ! harris41 78: $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{uc($key)}=
1.4 harris41 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;
1.6 harris41 97: $a=&make_file_type_ownership_and_permissions_description_block;
98: print $a;
1.4 harris41 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
1.7 harris41 121: <LI>File Type Ownership and Permissions
1.4 harris41 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>
1.5 harris41 139: <FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
1.4 harris41 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: }
1.1 harris41 178:
1.4 harris41 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>
1.9 ! harris41 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>
1.4 harris41 193: <TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0>
194: END
195: my $maxcount=0;
1.8 harris41 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: }
1.4 harris41 202: foreach my $d (@$dirs) {
203: my (@matches)=($d=~/\//g);
204: my $count=scalar(@matches);
205: $maxcount=$count if $count>$maxcount;
1.8 harris41 206: delete $diraccount{$d};
1.4 harris41 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";
1.8 harris41 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: }
1.4 harris41 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:
1.6 harris41 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:
1.4 harris41 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>
1.6 harris41 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,
1.7 harris41 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>.
1.6 harris41 300: </P>
1.4 harris41 301: <P>
1.9 ! harris41 302: <TABLE BORDER=1 CELLPADDING=5 WIDTH=500>
1.4 harris41 303: END
304: my $counter=0;
305: my @colorindex=("#80FF80","#80FFFF","#FFFF80");
1.5 harris41 306: my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
1.4 harris41 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) {
1.5 harris41 316: if ($d2=~/^$d\/([^\/]+)$/) {
1.4 harris41 317: push @subdirs,$1;
318: }
319: }
320: # find files that are contained in this directory
321: my @files;
1.5 harris41 322: my @filesfull;
1.4 harris41 323: foreach my $f (@allfiles) {
1.5 harris41 324: if ($f=~/^$d\/([^\/]+)$/) {
1.4 harris41 325: push @files,$1;
1.5 harris41 326: push @filesfull,$f;
1.4 harris41 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;
1.5 harris41 333: <TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
334: $subdirstring</FONT></TD></TR>
1.4 harris41 335: END
336: }
337: else {
338: $description.=<<END;
1.5 harris41 339: <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 340: END
341: }
342: if (@files) {
343: $description.=<<END;
344: <TR>
1.5 harris41 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>
1.4 harris41 350: </TR>
351: END
1.5 harris41 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'};
1.9 ! harris41 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;
1.7 harris41 378: unless (-e "../../$source") {
379: $source=~/([^\/]+)$/;
380: my $s=$1;
1.9 ! harris41 381: if ($source!~/\*/) {
! 382: $source="<FONT COLOR=#FF0000>$source</FONT>";
! 383: }
! 384: elsif ($eflag) {
! 385: $source="<FONT COLOR=#FF0000>$source</FONT>";
! 386: }
1.7 harris41 387: }
1.5 harris41 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 </TD>
394: <TD BGCOLOR=$color>$source</TD>
1.9 ! harris41 395: <TD BGCOLOR=$color>$note$listing$build$dependencies </TD>
1.4 harris41 396: </TR>
397: END
1.5 harris41 398: }
399: }
1.4 harris41 400: $counter++;
401: }
402: $description.=<<END;
403: </TABLE>
404: </P>
405: END
406: return $description;
407: }
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