Return to parse.pl CVS log

Up to [LON-CAPA] / loncom / build

works to render HTML output now.  still need to improve algorithm for
notes column rendering.  also need to include error checking and
other kinds of output (system update, RPM generation, etc) -Scott

#!/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=<IN>;
close IN;
my $info1=join('',@lines);
my $info2=$info1; # 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;
# file category mappings
my %fcm=(
	 'conf' => 'configurable',
	 'graphic file' => 'graphicfile',
	 'handler' => 'handler',
	 'interface file' => 'interfacefile',
	 'symbolic link' => 'link',
	 'root script' => 'rootscript',
	 'script' => 'script',
	 'setuid script' => 'setuid',
	 'static conf' => 'static',
	 'system file' => 'systemfile',
	 );

# ---------------------------------------------------- Parse the marked up data
my %info; # big data storage object
while ($info1=~/\<loncapa\s+(.*?)\>/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;
        $ckeystring=~s/(TARGET\=\"[^"]*)\*/$1\\\*/g;
        $info2=~/.*\<(?:metagroup|metasupergroup)\>(.*?)\<loncapa\s+$ckeystring\>(.*?)\<\/(?: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=<<END;
<HTML>
<HEAD>
<TITLE>LON-CAPA Software Description Page ($distribution, $date)</TITLE>
</HEAD>
<BODY>
<FONT SIZE=+2>LON-CAPA Software Description Page ($distribution, $date)</FONT>
<BR>Michigan State University
<BR>Learning Online with CAPA
<BR>Contact korte\@lon-capa.org
<UL>
<LI>About this file
<LI>Software Package Description
<LI>Directory Structure
<LI>File and Directory Structure
</UL>
<FONT SIZE=+2>About this file</FONT>
<P>
This file is generated dynamically by <TT>parse.pl</TT> as
part of a development compilation process.  See 
http://install.lon-capa.org/compile/index.html for more
information.
</P>
END
    return $description;
}

# ------------------------------------------------- End description page
sub end_description_page {
    my $description=<<END;
<HR>
<FONT SIZE=-1>LON-CAPA Software Development Team</FONT>
</BODY>
</HTML>
END
    return $description;
}

# ------------------------------------------------- Make RPM description block
sub make_rpm_description_block {
    my $description=<<END;
<FONT SIZE=+2>Rolled in a RedHat 6.2 RPM, $date</FONT>
<P>
<TABLE BGCOLOR=#FFFFFF BORDER=0 CELLPADDING=10 CELLSPACING=0>
<TR><TD>
<PRE>
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 : 
<PRE>
$info{'RPM'}{'description'}
</PRE>
</TD></TR>
</TABLE>
</P>
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=<<END;
<FONT SIZE=+2>Directory Structure Description, $date</FONT>
<P>
<TABLE BORDER=1 CELLPADDING=3 CELLSPACING=0>
END
    my $maxcount=0;
    foreach my $d (@$dirs) {
        my (@matches)=($d=~/\//g);
	my $count=scalar(@matches);
	$maxcount=$count if $count>$maxcount;
    }
    $description.=<<END;
<TR>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF>Category</TH>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF><FONT COLOR=#FF0000>Development<BR>Permissions</FONT></TH>
END
    $description.="<TH ALIGN=LEFT BGCOLOR=#FFFFFF COLSPAN=".($maxcount+1).">Directory Path</TH>\n";
    foreach my $d (@$dirs) {
	my $dtable=$d;
	$dtable=~s/\//\<\/TD\>\<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;
<TR>
<TD BGCOLOR=#FFFFFF>$category</TD>
<TD BGCOLOR=#FFFFFF><TT>$chmod $chown</TT></TD>
<TD BGCOLOR=#FFFFFF><FONT COLOR=#FF0000><TT>$devchmod $devchown</TT></FONT></TD>
<TD>
$dtable
</TD>
</TR>
END
    }
    $description.=<<END;
</TABLE>
</P>
END
    return $description;
}

# ------------------------- Make directory and file structure description block
sub make_directory_and_file_structure_description_block {
    my ($dirs)=@_;
    my $description=<<END;
<FONT SIZE=+2>Directory and File Structure Description, $date</FONT>
<P>
<TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
END
    my $counter=0;
    my @colorindex=("#80FF80","#80FFFF","#FFFF80");
    my @allfiles=keys %{$info{'LOCATION'}{$distribution}};
    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;
	my @filesfull;
	foreach my $f (@allfiles) {
	    if ($f=~/^$d\/([^\/]+)$/) {
		push @files,$1;
		push @filesfull,$f;
	    }
	}
	# render starting HTML formatting elements
	if (@subdirs || @files) {
	    my $subdirstring="<BR>* Relevant subdirectories: " . join(", ",@subdirs) if @subdirs;
	    $description.=<<END;
<TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="directory.gif" ALT="directory">DIRECTORY -- $d $dirdescription
$subdirstring</FONT></TD></TR>
END
        }
	else {
	    $description.=<<END;
<TR><TD BGCOLOR=#000000 COLSPAN=6><FONT COLOR=$color><IMG SRC="emptydirectory.gif" ALT="empty directory">EMPTY DIRECTORY - $d $dirdescription</FONT></TD></TR>
END
        }
	if (@files) {
	    $description.=<<END;
<TR>
<TH BGCOLOR=$color ALIGN=LEFT COLSPAN=2>Type</TH>
<TH BGCOLOR=$color ALIGN=LEFT>File Name</TH>
<TH BGCOLOR=$color ALIGN=LEFT>Function</TH>
<TH BGCOLOR=$color ALIGN=LEFT>CVS Location</TH>
<TH BGCOLOR=$color ALIGN=LEFT>Notes</TH>
</TR>
END
            foreach my $i (0..$#files) {
		my $category=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'CATEGORY'};
		my $fdescription=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'DESCRIPTION'};
		my $source=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'SOURCE'};
		my $notes=$info{'LOCATION'}{$distribution}{$filesfull[$i]}{'NOTES'};
		$description.=<<END;
<TR>
<TD BGCOLOR=#A0A0A0><IMG SRC="$fcm{$category}.gif" ALT="$category"></TD>
<TD BGCOLOR=$color>$category</TD>
<TD BGCOLOR=$color>$files[$i]</TD>
<TD BGCOLOR=$color>$fdescription&nbsp;</TD>
<TD BGCOLOR=$color>$source</TD>
<TD BGCOLOR=$color>$notes&nbsp;</TD>
</TR>
END
	    }
	}
	$counter++;
    }
    $description.=<<END;
</TABLE>
</P>
END
    return $description;
}