#!/usr/local/bin/perl use lib '/usr/local/rib/lib'; # NHSE Repository in a Box (RIB) # # The authors of this software are Paul McMahan and Jeff Horner. # 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); #$DEBUG = 1; ################# Acquire Important Variables and Arguments my $util = RIB::Util->new(); my ($repository,$buf); $buf = ''; my $RIBDIR = $util->GetRibDir(); my $RIBURL = $util->GetRibUrl(); my $RIBSP = $util->GetRibIsearchCgiPath(); my $RIBI = $util->GetRibIindexPath(); 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"; select(STDERR) ; $| = 1; # no output buffering select(STDOUT); $| = 1; ################# Print Header $util->PrintHeader(); print "\n"; print "Catalog Generation for $repository\n"; print "\n"; print "

Generating Catalog for $repository

\n"; print "

One Moment Please...

\n";
open(STDERR,">&STDOUT") || 
    $util->HtmlCroak("Cannot dup stdout. Please contact your RIB administrator.");

################# Load Assets Into Array

print "Gathering assets... \n";
unless (opendir (DIR,"$filepath/objects/Asset")) {
    print "
\n"; $util->HtmlCroak("Couldn't open the directory " . "$filepath/objects/Asset." . "

Reason: $!

Please contact your RIB administrator"); } #### Gather only those assets that have both object and catalog entries my @assets; foreach ( grep /\.html?$/i , readdir(DIR) ){ (-e "$filepath/catalog/Asset/$_") && push @assets, $_; } close(DIR); #my @assets = grep(/\.[hH][tT][mM][lL]?$/,readdir(DIR)); ################# Check for any Assets at all unless (-e "$filepath/catalog/.nonlocal" || @assets){ print "

No Assets in $repository

"; print "

Before attempting to create a catalog for $repository, you"; print " must create or import some assets."; print $util->BackToTop($repository); print $util->BackToTop(); exit; } ################# Load Configuration Object my $cp = RIB::ConfigParser->new(); #my $cp = 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() . ". Please ". "contact your RIB administrator"); } ################# Load Domain Object my $dp = RIB::DomainParser->new(); my $conf = "$filepath/conf/domains.html"; print "Loading domains file... \n"; unless ($dp->parse_file($conf)){ print "\n"; $util->HtmlCroak("There is a problem with $repository\'s ". "domains file. Problem: " . $dp->ErrorMsg() . ". Please ". "contact your RIB administrator"); } ################# Load Assets Into Domain Hierarcy my (%misc,$asset, $bp,$a); foreach $asset (@assets){ $bp = RIB::BIDMParser->new(); if ($bp->parse_file("$filepath/objects/Asset/$asset")) { # we call InstanceOf with an empty argument one because # this is a local asset. print "Loading asset $asset ... \n"; $a = $cp->InstanceOf('',"Asset",$bp); my ($val,$domain); my $placed = 0; foreach $val ($bp->valuesof("Domain")){ foreach $domain ($dp->domains()){ if ($val eq $domain){ $dp->AssetsOfDomain($val)->{$asset} = $a; $placed = 1; } } } unless ($placed){ $misc{$asset} = $a; } } else { print "\tThere was a problem loading $asset. Reason: " . $bp->ErrorMsg . "\n"; print ".\n\tThis asset will not be added to the catalog."; } undef($bp); undef($a); } ################# Load NonLocal Assets my $nonlocal_check = 0; if ($util->InitNonLocal($repository)) { my ($asset, $bp,$a); my (@nonlocals); @nonlocals = $util->NonLocalLink(); $util->CommitNonLocal(); foreach ( @nonlocals ){ $nonlocal_check = 1; my $url = ${_}->{URL}; my $lm = ${_}->{LM}; print "Loading nonlocal asset $url ... \n"; my $bp = RIB::BIDMParser->new(); my ($result,$content) = $bp->parse_url($url,\$lm); if ($result != 0 && $content ne ""){ $a = $cp->InstanceOf($url,"Asset",$bp); if ($result == 304 || !(-f "$filepath/catalog/Asset/".${_}->{FILE})){ # Update the catalog entry because the url has # been modified OR the catalog entry is non-existant my $err; unless ($util->UpdateNonLocal($_,$content,$lm,$a,$cp,\$err)){ print "\tThere was a problem loading $url. Reason: " . $err . ".\n\tThis asset will not be added to the catalog."; } } my $asset = ${_}->{FILE}; my ($val,$domain); my $placed = 0; foreach $val ($bp->valuesof("Domain")){ foreach $domain ($dp->domains()){ if ($val eq $domain){ $dp->AssetsOfDomain($val)->{$asset} = $a; $placed = 1; } } } unless ($placed){ $misc{$asset} = $a; } } else { print "\tThere was a problem loading $url. Reason: " . $bp->ErrorMsg ; print ".\n\tThis asset will not be added to the catalog.\n"; } undef($bp); undef($a); } } else { my $file = "$filepath/catalog/.nonlocal"; print "\tCouldn't open $file\n\tReason: $!.\n" if $DEBUG; print "\tOnly local assets will be added to the catalog\n"; } if (scalar(keys %misc) > 0){ $dp->AddDomain('Miscellaneous'); foreach (keys %misc){ $dp->AssetsOfDomain('Miscellaneous')->{$_} = $misc{$_}; } } ############# Isearch cgi stuff if (-e "$RIBSP/isrch_fetch" && -e "$RIBSP/isrch_srch" && -e "$RIBI/Iindex" ){ ################# Create Searchable Index for Catalog print "\nNow creating the searchable index for $repository...\n"; my $index = $RIBI . "/Iindex"; my $ipath = $RIBDIR . "/repositories/" . $repository . "/index/" . $repository; my $dpath = $RIBDIR . "/repositories/" . $repository . "/catalog"; unless (opendir (DIR,"$dpath")) { main::IndexerFailed("Couldn't open the directory $dpath." . "

Reason: $!

\n"); } my @files; foreach (readdir(DIR)){ if ($_ ne "." && $_ ne ".." && -d "$dpath/$_"){ unless (opendir(SDIR,"$dpath/$_") ) { main::IndexerFailed("Couldn't open $dpath/$_! Reason: $!"); } my $file; foreach $file (readdir(SDIR)) { if ($file ne '.' && $file ne '..' && !($file =~ /^\.+/) && !(-d "dpath${_}${file}")){ push @files, "$dpath/$_/$file"; } } } } my $files = join("\n",@files); my $tmpfile = "/tmp/rib$$"; # $$ is pid of the perl interp. unless (open (TMPFILE,">$tmpfile")){ main::IndexerFailed("Could't open a temporary file, $tmpfile: $!\n"); } print TMPFILE $files; close (TMPFILE); if (system("$index -d $ipath -t HTML -f $tmpfile")){ unlink($tmpfile); main::IndexerFailed("Perl's system() call died."); } unlink($tmpfile) || main::IndexerFailed("\tCannot remove $tmpfile\n"); } &write_catalog; sub IndexerFailed { my $buf = shift; &write_catalog(); die( "

The catalog for $repository has been created, but\n". " the indexing software failed. $buf . ". "Please contact your RIB administrator.". " In the meantime, you can view the catalog for ". "$repository, but it will not be searchable.

". "Click ". "here to view the catalog.\n". $util->BackToTop() . "\n" ); } ################# Write the catalog page # this is in a subroutine because it might need to be called from # &IndexerFailed before it dies. sub write_catalog { print "Creating top level index.html... \n"; unless (open (LMAIN,">$filepath/catalog/index.html")) { print "\n"; $util->HtmlCroak("\tCouldn't open file " . "$filepath/catalog/index.html" . " for writing.

\n" . "

Reason: $!

Please contact your RIB administrator\n"); } print LMAIN $util->ClassHeader('main'); if (-e "$RIBSP/isrch_fetch" && -e "$RIBSP/isrch_srch" && -e "$RIBI/Iindex"){ print LMAIN "Search the Catalog
\n"; print LMAIN qq(

); print LMAIN qq(); print LMAIN qq(); print LMAIN qq(); my $buf = "/rib/repositories/" . $repository . "/catalog/"; print LMAIN qq(); undef $buf; print LMAIN qq(); print LMAIN qq(); print LMAIN qq(); print LMAIN qq(
\n); print LMAIN "\nThis query tool searches full-text and supports" .' Boolean operators.
'; } my $buf = $dp->DomainsAsHtml; print LMAIN $buf; undef $buf; print LMAIN "
\n"; $buf = $dp->DomainsWithAssetsAsHtml($cp); print LMAIN $buf; undef $buf; print LMAIN "This catalog was generated ",$util->Date, " using "; print LMAIN "Repository In a Box (RIB) version "; print LMAIN $RIB::Util::VERSION, "
from\n"; print LMAIN ""; print LMAIN "local Assets\n"; if ($nonlocal_check) { print LMAIN "and \n"; print LMAIN ""; print LMAIN "nonlocal Assets"; } print LMAIN $util->ClassFooter('main'); close(LMAIN); print "

The catalog for $repository has been created.

\n"; print "Click "; print "here to view the catalog. If that page is already in your browser\'s"; print " cache then you may need to use your browser\'s reload button to "; print "force your browser to view the updated file.

"; print $util->BackToTop($repository); print "\n"; }