# NHSE Repository in a Box (RIB) # # The authors of this software is Paul McMahan. # Copyright (c) 1997 by the University of Tennessee. # Permission to use, copy, modify, and distribute this software for any # purpose without fee is hereby granted, provided that this entire notice # is included in all copies of any software which is or includes a copy # or modification of this software and in all copies of the supporting # documentation for such software. # THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED # WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR UNIVERSITY OF TENNESSEE # MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE # MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE. # use strict; use integer; use FileHandle; use RIB::Util (); use RIB::DomainParser (); use RIB::ConfigParser (); use RIB::BIDMParser (); use Data::Dumper (); use vars qw($DEBUG); ################# Acquire Important Variables and Arguments my $util = RIB::Util->new(); my ($repository,$buf); $buf = ''; my $RIBDIR = $util->GetRibDir(); my $RIBURL = $util->GetRibUrl(); if (@ARGV){ $repository = $ARGV[0]; } else { $repository = $util->GetRepoName(); } unless ($repository) { $util->ErrorMessage("A repository was not specified in your input"); } my $filepath = "$RIBDIR/repositories/$repository"; my $urlpath = "$RIBURL/repositories/$repository"; select(STDERR) ; $| = 1; # no output buffering select(STDOUT); $| = 1; ################# Print Header $util->PrintHeader(); print "\n"; print "Generating deployment grid\n"; print "\n"; print "

Generating deployment grid

\n"; ################ Load Configuration Object my $cp = RIB::ConfigParser->new(); unless ($cp->load_config("$filepath/conf/BIDM.conf")){ print "\n"; $util->HtmlCroak("There is a problem with $repository\'s ". "configuration file. Problem: " . $cp->ErrorMsg() . "."); } ################# my %assets = {}; my %machines = {}; my %deployments = {}; =head1 ################# load %machines unless (opendir (DIR,"$filepath/objects/Machine")) { print "\n"; $util->HtmlCroak("Couldn't open the directory " . "$filepath/objects/Machine." . "

Reason: $!"); } foreach (grep /\.html?$/i , readdir(DIR) ){ my $file = "$filepath/objects/Machine/$_"; # parse the deployment file my $Machine = RIB::BIDMParser->new(); $Machine->parse_file($file); # determine the catalog entry for this asset my $ce = $file; $ce =~ s/$RIBDIR/$RIBURL/i; $ce =~ s/objects/catalog/i; my $machine = $Machine->valueof("Name"); $machines{$machine} = $ce; } close DIR; ################# load %assets unless (opendir (DIR,"$RIBDIR/repositories/ncsa_teamA/objects/Asset")) { print "\n"; $util->HtmlCroak("Couldn't open the directory " . "$RIBDIR/repositories/ncsa_teamA/objects/Asset" . "

Reason: $!

Please contact rib\@nhse.org"); } foreach (grep /\.html?$/i , readdir(DIR) ){ my $file = "$RIBDIR/repositories/ncsa_teamA/objects/Asset/$_"; # parse the deployment file my $Asset = RIB::BIDMParser->new(); $Asset->parse_file($file); # determine the catalog entry for this asset my $ce = $file; $ce =~ s/$RIBDIR/$RIBURL/i; #$ce =~ s/objects/catalog/i; my $asset = $Asset->valueof("Name"); $assets{$asset} = $ce; } close DIR; =cut ################# Parse Deployment objects unless (opendir (DIR,"$filepath/objects/Deployment")) { print "\n"; $util->HtmlCroak("Couldn't open the directory " . "$filepath/objects/Deployment." . "

Reason: $!"); } foreach ( grep /\.html?$/i , readdir(DIR) ){ # parse the deployment file my $Deployment = RIB::BIDMParser->new(); $Deployment->parse_file("$filepath/objects/Deployment/$_"); ###################################################### # determine which Machine this deployment is on my $url1= $Deployment->valueof("DeployedOn"); my $DeployedOn = RIB::BIDMParser->new(); $DeployedOn->parse_url($url1); my $machine = $DeployedOn->valueof("Name"); $machines{$machine} = $url1; ###################################################### # determine which Asset this is a deployment of my $url2= $Deployment->valueof("IsDeploymentOf"); my $IsDeploymentOf = RIB::BIDMParser->new(); $IsDeploymentOf->parse_url($url2); my $asset = $IsDeploymentOf->valueof("Name"); $assets{$asset} = $url2; ###################################################### # now store the status of the deployment and url to its catalog entry my $status = $Deployment->valueof("Status"); $deployments{$machine}{$asset} = "$status"; } closedir DIR; ################################################################## # get lock for the grid html file and then open it my $grid = "$filepath/catalog/grid.html"; my $gridlock = "$filepath/catalog/grid.html.lock"; while (-e $gridlock) { if ((stat($gridlock))[10] < (time - 60)) { unlink $gridlock or $util->HtmlCroak("Can't unlink grid lock file : $!"); } sleep 5; } unless (open(GRIDLOCK, ">$gridlock")) { $util->HtmlCroak("Can't create grid lock file : $!"); } close GRIDLOCK; unless (open (GRID,">$grid")) { unlink ($gridlock); $util->HtmlCroak("Can't create grid file : $!"); } ################################################################## # print the grid select GRID; my $tmp_date = localtime(time); if (open (HEADER,"$filepath/conf/grid.header")){ print (

); close HEADER; } print <<"EOF";

This grid was created on $tmp_date

EOF my $machine; foreach $machine (sort keys %machines) { my $url = $machines{$machine}; if ($machines{$machine} !~ /$urlpath/) { $url = $RIBURL . "/cgi-bin/pub/show_object.pl?r=$repository&u=$machines{$machine}"; } else { $url =~ s,/objects/,/catalog/,; } print "\n"; } print "\n"; my $asset; foreach $asset (sort keys %assets) { print "\n"; my $url = $assets{$asset}; if ($assets{$asset} !~ /$urlpath/) { $url = $RIBURL . "/cgi-bin/pub/show_object.pl?r=$repository&u=$assets{$asset}"; } else { $url =~ s,/objects/,/catalog/,; } print "\n"; foreach $machine (sort keys %machines) { print "\n"; } print "\n"; } print "
 $machine
$asset"; if (defined $deployments{$machine}{$asset}) { print $deployments{$machine}{$asset}; } else { print "-"; } print "
\n"; if (open (FOOTER,"$filepath/conf/grid.footer")){ print (