File:  [LON-CAPA] / loncom / build / Attic / parse.pl
Revision 1.6: download - view: text, annotated - select for diffs
Sat Dec 9 19:29:16 2000 UTC (24 years ago) by harris41
Branches: MAIN
CVS tags: HEAD
inserted HTML output to describe file permissions.. also some
category descriptionson the HTML output page... still fixing -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_file_type_ownership_and_permissions_description_block;
    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 file type ownership and permissions description block
sub make_file_type_ownership_and_permissions_description_block {
    my $description=<<END;
<FONT SIZE=+2>File Type Ownership and Permissions Descriptions, $date</FONT>
<P>
This table shows what permissions and ownership settings correspond
to each kind of file type.
</P>
<P>
<TABLE BORDER=1 CELLPADDING=5 WIDTH=60%>
<TR>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF>Icon</TH>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF>Type</TH>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF>Permissions</TH>
<TH ALIGN=LEFT BGCOLOR=#FFFFFF>Development Permissions</TH>
</TR>
END
    foreach my $type (keys %{$info{'OWNERSHIP'}}) {
	if (defined($fcm{$type})) {
	    my $chmod=$info{'OWNERSHIP'}{$type}{'CHMOD'};
	    my $chown=$info{'OWNERSHIP'}{$type}{'CHOWN'};
	    my $devchmod=$info{'DEVOWNERSHIP'}{$type}{'CHMOD'};
	    my $devchown=$info{'DEVOWNERSHIP'}{$type}{'CHOWN'};
	    $description.=<<END;
<TR>
<TD><IMG SRC="$fcm{$type}.gif" ALT="$type"></TD>
<TD>$type</TD>
<TD><TT>$chmod $chown</TT></TD>
<TD><TT>$devchmod $devchown</TT></TD>
</TR>
END
        }
    }
    $description.=<<END;
</TABLE>
</P>
END
}

# ------------------------- 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>
The icons on the left column correspond to the file type
specified in the second column.  The last column "Notes" shows compilation,
dependency, and configuration information.
</P>
<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;
}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>