loncom/build/parse.pl - view

File: [LON-CAPA] / loncom / build / Attic / parse.pl
Revision 1.10: download - view: text, annotated - select for diffs
Sun Dec 10 17:27:11 2000 UTC (23 years, 6 months ago) by harris41
Branches: MAIN
CVS tags: HEAD

implementing two important make targets which help to install/upgrade/etc
most anything (targets are SPEC and LCMakefile)
there will be some minor modifications still to be done to fit this
into make_rpm.pl strategy or a CVS update strategy -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'}}{'LINKTO'}= $hash{'LINKTO'}; 69: $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'SOURCE'}= $hash{'SOURCE'}; 70: # get surrounding metagroup information 71: my $ckeystring=$keystring; $ckeystring=~s/(SOURCE\=\"[^"]*)\*/$1\\\*/g; 72: $ckeystring=~s/(TARGET\=\"[^"]*)\*/$1\\\*/g; 73: $info2=~/.*\<(?:metagroup|metasupergroup)\>(.*?)\<loncapa\s+$ckeystring\>(.*?)\<\/(?:metagroup|metasupergroup)\>/is; 74: my $data=$1.$2; 75: my @meta=('description','build','dependencies','files','note'); 76: foreach my $m (@meta) { 77: if ($data=~/\<($m)\>(.*?)\<\/$m\>/sgi) { 78: my ($key,$value)=($1,$2); 79: $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{uc($key)}= 80: $value; 81: } 82: } 83: } 84: else { 85: warn("WARNING: this tag text will be ignored since it cannot be understood\n---> $keystring\n"); 86: } 87: } 88: 89: my $a; 90: my @directories; 91: if ($mode eq "HTML") { 92: $a=&begin_description_page; 93: print $a; 94: $a=&make_rpm_description_block; 95: print $a; 96: @directories=&determine_directory_structure; 97: $a=&make_directory_structure_description_block(\@directories); 98: print $a; 99: $a=&make_file_type_ownership_and_permissions_description_block; 100: print $a; 101: $a=&make_directory_and_file_structure_description_block(\@directories); 102: print $a; 103: $a=&end_description_page; 104: print $a; 105: } 106: elsif ($mode eq "SPEC") { 107: my $out=$info{'RPM'}{'Name'} . '-' . $info{'RPM'}{'Version'} . '.spec'; 108: open OUT,">$out"; 109: $a=&make_rpm_spec_block; 110: print OUT $a; 111: $a=&make_rpm_build_block; 112: print OUT $a; 113: @directories=&determine_directory_structure; 114: $a=&make_directory_structure_spec_block(\@directories); 115: print OUT $a; 116: $a=&make_directory_and_file_structure_spec_block(\@directories); 117: print OUT $a; 118: $a=&end_spec_page; 119: print OUT $a; 120: close OUT; 121: } 122: elsif ($mode eq "LCMakefile") { 123: @directories=&determine_directory_structure; 124: $a=&make_directory_install_segment(\@directories); 125: print $a; 126: $a=&make_files_install_segment(\@directories); 127: print $a; 128: $a=&make_links_install_segment(\@directories); 129: print $a; 130: } 131: elsif ($mode eq "status") { 132: } 133: elsif ($mode eq "update") { 134: } 135: elsif ($mode eq "freshinstall") { 136: } 137: 138: # --------------------------------- Installation commands to install directories 139: sub make_directory_install_segment { 140: my ($dirs)=@_; 141: my $description=<<END; 142: directories: 143: END 144: foreach my $d (@$dirs) { 145: my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'}; 146: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 147: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 148: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 149: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 150: my $own=$devchown; $own=~s/\:/\,/; 151: $description.=<<END; 152: \tinstall -m $devchmod -d \$(SOURCE)/$d \$(ROOT)/$d 153: END 154: } 155: $description.=<<END; 156: 157: END 158: return $description; 159: } 160: 161: # --------------------------------------- Installation commands to install files 162: sub make_files_install_segment { 163: my ($dirs)=@_; 164: my $description=<<END; 165: files: 166: END 167: my @allfiles=keys %{$info{'LOCATION'}{$distribution}}; 168: foreach my $d (@$dirs) { 169: # set other values 170: my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'}; 171: $dirdescription="(" . $dirdescription . ")" if $dirdescription; 172: # find files that are contained in this directory 173: my @files; 174: my @filesfull; 175: foreach my $f (@allfiles) { 176: if ($f=~/^$d\/([^\/]+)$/) { 177: push @files,$1; 178: push @filesfull,$f; 179: } 180: } 181: # render starting HTML formatting elements 182: if (@files) { 183: $description.=<<END; 184: \t# $d $dirdescription 185: END 186: } 187: if (@files) { 188: foreach my $i (0..$#files) { 189: my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'}; 190: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 191: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 192: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 193: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 194: my $rot=$filesfull[$i]; 195: $rot=~s/[^\/]+$/\./ if $rot=~/\*/; 196: $description.=<<END if $category ne 'symbolic link'; 197: \tinstall -m $devchmod \$(SOURCE)/$filesfull[$i] \$(ROOT)/$rot 198: END 199: } 200: } 201: } 202: $description.=<<END; 203: 204: END 205: return $description; 206: } 207: 208: # ------------------------------ Installation commands to install symbolic links 209: sub make_links_install_segment { 210: my ($dirs)=@_; 211: my $description=<<END; 212: links: 213: END 214: my @allfiles=keys %{$info{'LOCATION'}{$distribution}}; 215: foreach my $d (@$dirs) { 216: # find files that are contained in this directory 217: my @files; 218: my @filesfull; 219: foreach my $f (@allfiles) { 220: if ($f=~/^$d\/([^\/]+)$/) { 221: push @files,$1; 222: push @filesfull,$f; 223: } 224: } 225: # render starting HTML formatting elements 226: if (@files) { 227: foreach my $i (0..$#files) { 228: my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'}; 229: my $linkto=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'LINKTO'}; 230: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 231: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 232: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 233: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 234: $description.=<<END if $category eq 'symbolic link'; 235: \tln -s /$linkto \$(ROOT)/$filesfull[$i] 236: END 237: } 238: } 239: } 240: $description.=<<END; 241: 242: END 243: return $description; 244: } 245: 246: # --------------------------------------------------------- Make RPM .spec block 247: sub make_rpm_spec_block { 248: my $pwd=`pwd`; chop $pwd; 249: my $buildroot="$pwd/LON-CAPA-BuildRoot"; 250: my $source=$info{'RPM'}{'Name'} . "-" . $info{'RPM'}{'Version'} . '.tar.gz'; 251: my $description=<<END; 252: Summary: $info{'RPM'}{'Summary'} 253: Name: $info{'RPM'}{'Name'} 254: Version: $info{'RPM'}{'Version'} 255: Release: $info{'RPM'}{'Release'} 256: Vendor: $info{'RPM'}{'Vendor'} 257: BuildRoot: $buildroot 258: Copyright: $info{'RPM'}{'Copyright'} 259: Group: $info{'RPM'}{'Group'} 260: Source: $source 261: AutoReqProv: $info{'RPM'}{'AutoReqProv'} 262: \%description 263: $info{'RPM'}{'description'} 264: 265: END 266: return $description; 267: } 268: 269: # --------------------------------------------------- Make RPM build .spec block 270: sub make_rpm_build_block { 271: my $pwd=`pwd`; chop $pwd; 272: my $buildroot="$pwd/LON-CAPA-BuildRoot"; 273: my $sourceroot="$pwd/LON-CAPA-SourceRoot"; 274: my $description=<<END; 275: 276: \%prep 277: \%setup 278: 279: \%build 280: rm -Rf "$buildroot" 281: 282: \%install 283: make -f LCMakefile ROOT="\$RPM_BUILD_ROOT" SOURCE="$sourceroot" directories 284: make -f LCMakefile ROOT="\$RPM_BUILD_ROOT" SOURCE="$sourceroot" files 285: make -f LCMakefile ROOT="\$RPM_BUILD_ROOT" SOURCE="$sourceroot" links 286: 287: \%pre 288: $info{'RPM'}{'pre'} 289: 290: \%post 291: \%postun 292: 293: \%files 294: # \%doc README COPYING ChangeLog LICENSE 295: END 296: return $description; 297: } 298: 299: # ------------------------------------- Make directory structure RPM .spec block 300: sub make_directory_structure_spec_block { 301: my ($dirs)=@_; 302: foreach my $d (@$dirs) { 303: my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'}; 304: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 305: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 306: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 307: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 308: my $own=$devchown; $own=~s/\:/\,/; 309: $description.=<<END; 310: \%dir \%attr($devchmod,$own) /$d 311: END 312: } 313: return $description; 314: } 315: 316: # ---------------------------- Make directory and file structure RPM .spec block 317: sub make_directory_and_file_structure_spec_block { 318: my ($dirs)=@_; 319: my @allfiles=keys %{$info{'LOCATION'}{$distribution}}; 320: foreach my $d (@$dirs) { 321: # set other values 322: my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'}; 323: $dirdescription="(" . $dirdescription . ")" if $dirdescription; 324: # find files that are contained in this directory 325: my @files; 326: my @filesfull; 327: foreach my $f (@allfiles) { 328: if ($f=~/^$d\/([^\/]+)$/) { 329: push @files,$1; 330: push @filesfull,$f; 331: } 332: } 333: # render starting HTML formatting elements 334: if (@files) { 335: $description.=<<END; 336: # $d $dirdescription 337: END 338: } 339: if (@files) { 340: foreach my $i (0..$#files) { 341: my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'}; 342: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 343: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 344: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 345: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 346: my $own=$devchown; $own=~s/\:/\,/; 347: my $config=""; 348: $config="\%config " if $category eq 'conf'; 349: $devchmod='-' if $category eq 'symbolic link'; 350: $description.=<<END; 351: $config\%attr($devchmod,$own) /$filesfull[$i] 352: END 353: } 354: } 355: } 356: return $description; 357: } 358: 359: # ----------------------------------------------------------- End RPM .spec page 360: sub end_spec_page { 361: } 362: 363: # ------------------------------------------------------- Begin description page 364: sub begin_description_page { 365: my $description=<<END; 366: <HTML> 367: <HEAD> 368: <TITLE>LON-CAPA Software Description Page ($distribution, $date)</TITLE> 369: </HEAD> 370: <BODY> 371: LON-CAPA Software Description Page ($distribution, $date) 372: Michigan State University 373: Learning Online with CAPA 374: Contact korte\@lon-capa.org 375: <UL> 376: <LI>About this file 377: <LI>Software Package Description 378: <LI>Directory Structure 379: <LI>File Type Ownership and Permissions 380: <LI>File and Directory Structure 381: </UL> 382: About this file 383: 384: This file is generated dynamically by <TT>parse.pl</TT> as 385: part of a development compilation process. See 386: http://install.lon-capa.org/compile/index.html for more 387: information. 388: 389: END 390: return $description; 391: } 392: 393: # ------------------------------------------------- End description page 394: sub end_description_page { 395: my $description=<<END; 396: <HR> 397: LON-CAPA Software Development Team 398: </BODY> 399: </HTML> 400: END 401: return $description; 402: } 403: 404: # ------------------------------------------------- Make RPM description block 405: sub make_rpm_description_block { 406: my $description=<<END; 407: Rolled in a RedHat 6.2 RPM, $date 408: 409: <TABLE BGCOLOR=#FFFFFF BORDER=0 CELLPADDING=10 CELLSPACING=0> 410: <TR><TD> 411: <PRE> 412: Name : $info{'RPM'}{'Name'} 413: Version : $info{'RPM'}{'Version'} 414: Vendor : $info{'RPM'}{'Vendor'} 415: Release : $info{'RPM'}{'Release'} 416: Build Host : $buildhost 417: Group : $info{'RPM'}{'Group'} 418: License : $info{'RPM'}{'Copyright'} 419: Summary : $info{'RPM'}{'Summary'} 420: Description : 421: $info{'RPM'}{'description'} 422: </PRE> 423: </TD></TR> 424: </TABLE> 425: 426: END 427: return $description; 428: } 429: 430: # ----------------------------------------------- Determine directory structure 431: sub determine_directory_structure { 432: my @directories=keys %{$info{'DIRECTORY'}{$distribution}}; 433: return (sort @directories); 434: } 435: 436: 437: # ---------------------------------- Make directory structure description block 438: sub make_directory_structure_description_block { 439: my ($dirs)=@_; 440: my $description=<<END; 441: Directory Structure Description, $date 442: 443: The directory structure description below shows only those 444: directories which either contain LON-CAPA specific files 445: or normally do not exist on a RedHat Linux system (and 446: must be generated to allow proper placement of files 447: during LON-CAPA run-time operation). 448: 449: 450: <TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0> 451: END 452: my $maxcount=0; 453: my @allfiles=keys %{$info{'LOCATION'}{$distribution}}; 454: my %diraccount; # hash to track which directories are accounted for 455: foreach my $file (@allfiles) { 456: $file=~/^(.*)\/([^\/]+)$/; 457: $diraccount{$1}=1; 458: } 459: foreach my $d (@$dirs) { 460: my (@matches)=($d=~/\//g); 461: my $count=scalar(@matches); 462: $maxcount=$count if $count>$maxcount; 463: delete $diraccount{$d}; 464: } 465: $description.=<<END; 466: <TR> 467: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Category</TH> 468: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH> 469: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH> 470: END 471: $description.="<TH ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+1).">Directory Path</TH>\n"; 472: if (keys %diraccount) { 473: $description.= "<TR><TD ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+4)."><PRE>Directories that are unaccounted for: \n"; 474: foreach my $d (keys %diraccount) { 475: $description.="$d\n"; 476: } 477: $description.="</PRE></TH></TR>\n"; 478: } 479: foreach my $d (@$dirs) { 480: my $dtable=$d; 481: $dtable=~s/\//\<\/TD\>\<TD\>/g; 482: my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'}; 483: my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; 484: my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; 485: my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; 486: my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; 487: $description.=<<END; 488: <TR> 489: <TD BGCOLOR=#FFFFFF>$category</TD> 490: <TD BGCOLOR=#FFFFFF><TT>$chmod $chown</TT></TD> 491: <TD BGCOLOR=#FFFFFF><TT>$devchmod $devchown</TT></TD> 492: <TD> 493: $dtable 494: </TD> 495: </TR> 496: END 497: } 498: $description.=<<END; 499: </TABLE> 500: 501: END 502: return $description; 503: } 504: 505: # ------------------- Make file type ownership and permissions description block 506: sub make_file_type_ownership_and_permissions_description_block { 507: my $description=<<END; 508: File Type Ownership and Permissions Descriptions, $date 509: 510: This table shows what permissions and ownership settings correspond 511: to each kind of file type. 512: 513: 514: <TABLE BORDER=1 CELLPADDING=5 WIDTH=60%> 515: <TR> 516: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Icon</TH> 517: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Type</TH> 518: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH> 519: <TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH> 520: </TR> 521: END 522: foreach my $type (keys %{$info{'OWNERSHIP'}}) { 523: if (defined($fcm{$type})) { 524: my $chmod=$info{'OWNERSHIP'}{$type}{'CHMOD'}; 525: my $chown=$info{'OWNERSHIP'}{$type}{'CHOWN'}; 526: my $devchmod=$info{'DEVOWNERSHIP'}{$type}{'CHMOD'}; 527: my $devchown=$info{'DEVOWNERSHIP'}{$type}{'CHOWN'}; 528: $description.=<<END; 529: <TR> 530: <TD><IMG SRC="$fcm{$type}.gif" ALT="$type"></TD> 531: <TD>$type</TD> 532: <TD><TT>$chmod $chown</TT></TD> 533: <TD><TT>$devchmod $devchown</TT></TD> 534: </TR> 535: END 536: } 537: } 538: $description.=<<END; 539: </TABLE> 540: 541: END 542: } 543: 544: # ------------------------- Make directory and file structure description block 545: sub make_directory_and_file_structure_description_block { 546: my ($dirs)=@_; 547: my $description=<<END; 548: Directory and File Structure Description, $date 549: 550: The icons on the left column correspond to the file type 551: specified in the second column. The last column "Notes" shows compilation, 552: dependency, and configuration information. The CVS location 553: shows the location of the binary source file (if applicable) needed to 554: be copied to the target. If the binary source file is not at 555: the specified location, then the text is shown in 556: red. 557: 558: 559: <TABLE BORDER=1 CELLPADDING=5 WIDTH=500> 560: END 561: my $counter=0; 562: my @colorindex=("#80FF80","#80FFFF","#FFFF80"); 563: my @allfiles=keys %{$info{'LOCATION'}{$distribution}}; 564: foreach my $d (@$dirs) { 565: # set color 566: my $color=$colorindex[$counter%3]; 567: # set other values 568: my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'}; 569: $dirdescription="(" . $dirdescription . ")" if $dirdescription; 570: # find subdirectories that are contained in this directory 571: my @subdirs; 572: foreach my $d2 (@$dirs) { 573: if ($d2=~/^$d\/([^\/]+)$/) { 574: push @subdirs,$1; 575: } 576: } 577: # find files that are contained in this directory 578: my @files; 579: my @filesfull; 580: foreach my $f (@allfiles) { 581: if ($f=~/^$d\/([^\/]+)$/) { 582: push @files,$1; 583: push @filesfull,$f; 584: } 585: } 586: # render starting HTML formatting elements 587: if (@subdirs || @files) { 588: my $subdirstring=" * Relevant subdirectories: " . join(", ",@subdirs) if @subdirs; 589: $description.=<<END; 590: <TR><TD BGCOLOR=#000000 COLSPAN=6><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription 591: $subdirstring</TD></TR> 592: END 593: } 594: else { 595: $description.=<<END; 596: <TR><TD BGCOLOR=#000000 COLSPAN=6><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</TD></TR> 597: END 598: } 599: if (@files) { 600: $description.=<<END; 601: <TR> 602: <TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH> 603: <TH BGCOLOR=$color ALIGN=LEFT>File Name</TH> 604: <TH BGCOLOR=$color ALIGN=LEFT>Function</TH> 605: <TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH> 606: <TH BGCOLOR=$color ALIGN=LEFT>Notes</TH> 607: </TR> 608: END 609: foreach my $i (0..$#files) { 610: my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'}; 611: my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'}; 612: my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'}; 613: my $note=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'NOTE'}; 614: $note.=" " if $note; 615: my $listing=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'FILES'}; 616: my @E=split(/\s+/,$listing); 617: $source=~/(.*)\/[^\/]+$/; 618: my $sd=$1; 619: my $eflag=0; 620: foreach my $e (@E) { 621: unless (-e "../../$sd/$e") { 622: $e="$e"; 623: $eflag=1; 624: } 625: } 626: $listing=join("\n",@E); 627: $listing="listing $listing" if $listing; 628: $listing.=" " if $listing; 629: my $build=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'BUILD'}; 630: $build="build $build" if $build; 631: $build.=" " if $build; 632: my $dependencies=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DEPENDENCIES'}; 633: $dependencies="dependencies $dependencies" if $dependencies; 634: $dependencies.=" " if $dependencies; 635: unless (-e "../../$source") { 636: $source=~/([^\/]+)$/; 637: my $s=$1; 638: if ($source!~/\*/) { 639: $source="$source"; 640: } 641: elsif ($eflag) { 642: $source="$source"; 643: } 644: } 645: $description.=<<END; 646: <TR> 647: <TD BGCOLOR=#A0A0A0><IMG SRC="$fcm{$category}.gif" ALT="$category"></TD> 648: <TD BGCOLOR=$color>$category</TD> 649: <TD BGCOLOR=$color>$files[$i]</TD> 650: <TD BGCOLOR=$color>$fdescription </TD> 651: <TD BGCOLOR=$color>$source</TD> 652: <TD BGCOLOR=$color>$note$listing$build$dependencies </TD> 653: </TR> 654: END 655: } 656: } 657: $counter++; 658: } 659: $description.=<<END; 660: </TABLE> 661: 662: END 663: return $description; 664: }