#!/usr/bin/perl # Scott Harrison # November 2000 # Read in loncapa tags and metagroup tags # ---------------------------------------------- Read in command line arguments my ($file,$mode)=@ARGV; # ---------------------------------------------------- Read in master data file open IN,"<$file"; my @lines=; close IN; my $info=join('',@lines); my $info2=$info; # value to allow for meta data group retrieval # ------------------------------------------------------- Make default settings my $distribution="redhat6.2"; my $date=`date +'%B %e, %Y'`; chop $date; my $buildhost=`hostname`; chop $buildhost; # ---------------------------------------------------- Parse the marked up data my %info; # big data storage object while ($info=~/\/isg) { my $keystring=$1; # In the parsing of LON-CAPA tags, remove boundary white-space, # and handle quotation commands. my %hash=map {my ($key,$value)=split(/\=(?!")|\=(?=\s*"[^"]*"[^"]*$)/); $value=~s/^"//; $value=~s/"$//; (uc($key),$value);} split(/\s+(?=\w+\s*\=)/,$keystring); # Handle the different types of commands if (uc($hash{'TYPE'}) eq "OWNERSHIP") { $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHMOD'}=$hash{'CHMOD'}; $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHOWN'}=$hash{'CHOWN'}; } elsif (uc($hash{'TYPE'}) eq "DEVOWNERSHIP") { $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHMOD'}=$hash{'CHMOD'}; $info{$hash{'TYPE'}}{$hash{'CATEGORY'}}{'CHOWN'}=$hash{'CHOWN'}; } elsif (uc($hash{'TYPE'}) eq "RPM") { $hash{'VALUE'}=~s/\\n/\n/g; $info{$hash{'TYPE'}}{$hash{'NAME'}}=$hash{'VALUE'}; } elsif (uc($hash{'TYPE'}) eq "DIRECTORY") { $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}= $hash{'CATEGORY'}; $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'DESCRIPTION'}= $hash{'DESCRIPTION'} if $hash{'DESCRIPTION'}; } elsif (uc($hash{'TYPE'}) eq "LOCATION") { $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'CATEGORY'}= $hash{'CATEGORY'}; $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{'SOURCE'}= $hash{'SOURCE'}; # get surrounding metagroup information my $ckeystring=$keystring; $ckeystring=~s/(SOURCE\=\"[^"]*)\*/$1\\\*/g; $info2=~/.*\<(?:metagroup|metasupergroup)\>(.*?)\(.*?)\<\/(?:metagroup|metasupergroup)\>/is; my $data=$1.$2; my @meta=('description','build','dependencies','files','note'); foreach my $m (@meta) { if ($data=~/\<($m)\>(.*?)\<\/$m\>/sgi) { my ($key,$value)=($1,$2); $info{$hash{'TYPE'}}{$hash{'DIST'}}{$hash{'TARGET'}}{$key}= $value; } } } else { warn("WARNING: this tag text will be ignored since it cannot be understood\n---> $keystring\n"); } } if ($mode eq "ALL" || $mode eq "HTML") { my $a; $a=&begin_description_page; print $a; $a=&make_rpm_description_block; print $a; @directories=&determine_directory_structure; $a=&make_directory_structure_description_block(\@directories); print $a; $a=&make_directory_and_file_structure_description_block(\@directories); print $a; $a=&end_description_page; print $a; } # ------------------------------------------------- Begin description page sub begin_description_page { my $description=< LON-CAPA Software Description Page ($distribution, $date) LON-CAPA Software Description Page ($distribution, $date)
Michigan State University
Learning Online with CAPA
Contact korte\@lon-capa.org
  • About this file
  • Software Package Description
  • Directory Structure
  • File and Directory Structure
About this file

This file is generated dynamically by parse.pl as part of a development compilation process. See http://install.lon-capa.org/compile/index.html for more information.

END return $description; } # ------------------------------------------------- End description page sub end_description_page { my $description=< LON-CAPA Software Development Team END return $description; } # ------------------------------------------------- Make RPM description block sub make_rpm_description_block { my $description=<Rolled in a RedHat 6.2 RPM, $date 

Name        : $info{'RPM'}{'Name'}
Version     : $info{'RPM'}{'Version'}
Vendor      : $info{'RPM'}{'Vendor'} 
Release     : $info{'RPM'}{'Release'}                             
Build Host  : $buildhost
Group       : $info{'RPM'}{'Group'}
License     : $info{'RPM'}{'Copyright'}
Summary     : $info{'RPM'}{'Summary'}
Description : 

$info{'RPM'}{'description'}

END return $description; } # ----------------------------------------------- Determine directory structure sub determine_directory_structure { my @directories=keys %{$info{'DIRECTORY'}{$distribution}}; return (sort @directories); } # ---------------------------------- Make directory structure description block sub make_directory_structure_description_block { my ($dirs)=@_; my $description=<Directory Structure Description, $date

END my $maxcount=0; foreach my $d (@$dirs) { my (@matches)=($d=~/\//g); my $count=scalar(@matches); $maxcount=$count if $count>$maxcount; } $description.=< END $description.="\n"; foreach my $d (@$dirs) { my $dtable=$d; $dtable=~s/\//\<\/TD\>\/g; my $category=$info{'DIRECTORY'}{$distribution}{$d}{'CATEGORY'}; my $chown=$info{'OWNERSHIP'}{$category}{'CHOWN'}; my $chmod=$info{'OWNERSHIP'}{$category}{'CHMOD'}; my $devchown=$info{'DEVOWNERSHIP'}{$category}{'CHOWN'}; my $devchmod=$info{'DEVOWNERSHIP'}{$category}{'CHMOD'}; $description.=< END } $description.=<

END return $description; } # ------------------------- Make directory and file structure description block sub make_directory_and_file_structure_description_block { my ($dirs)=@_; my $description=<Directory and File Structure Description, $date

Category Permissions Development
Permissions		Directory Path$category $chmod $chown $devchmod $devchown $dtable
END my $counter=0; my @colorindex=("#80FF80","#80FFFF","#FFFF80"); my @allfiles=keys %{$info{'LOCATION'}{$distribution}{'TARGET'}}; foreach my $d (@$dirs) { # set color my $color=$colorindex[$counter%3]; # set other values my $dirdescription=$info{'DIRECTORY'}{$distribution}{$d}{'DESCRIPTION'}; $dirdescription="(" . $dirdescription . ")" if $dirdescription; # find subdirectories that are contained in this directory my @subdirs; foreach my $d2 (@$dirs) { if ($d2=~/$d\/([^\/]+)/) { push @subdirs,$1; } } # find files that are contained in this directory my @files; foreach my $f (@allfiles) { if ($file=~/$d\/(.+)/) { push @files,$1; } } # render starting HTML formatting elements if (@subdirs || @files) { my $subdirstring="
* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs; $description.=< END } if (@files) { $description.=< END } $description.=< END $counter++; } $description.=<

END return $description; }
directoryDIRECTORY -- $d $dirdescription $subdirstring END } else { $description.=<empty directoryEMPTY DIRECTORY - $d $dirdescriptionType File Name Function Notes