Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Engine
In directory usw-pr-cvs1:/tmp/cvs-serv18415
Added Files:
LibLoader.pm
Log Message:
--- NEW FILE: LibLoader.pm ---
#--------------------------------------------------------
# $Id: LibLoader.pm,v 1.1 2002/06/16 18:15:12 derkork Exp $
#
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
# (C) 2000-2002 by Jan Thomä, insOMnia
# mailto: ko...@in...
#--------------------------------------------------------
use strict;
#/**
# This class is responsible for loading libraries. It loads
# libraries by name. The convention is, that the libraries have
# to be in a file named <LibraryName>Library.pm. Libraries
# can be loaded from local filesystem only.
#*/
package NetScript::Engine::LibLoader;
#--------------------------------------------------------
# Imports
#--------------------------------------------------------
use NetScript::Interpreter;
#--------------------------------------------------------
# Globals
#--------------------------------------------------------
#/**
# The constructor.
# @param an instance of NetScript::Interpreter.
# @param the base directory where the libraries are located.
#*/
sub new {
my ($proto, $interpreter, $baseDir) = @_;
my $class = ref( $proto ) || $proto;# get the Classname
my $this = {};
bless( $this, $class ); # create Object
my %importedLibs = ();
$this -> { m_ImportedLibs } = \%importedLibs;
$this -> { m_BaseDir } = $baseDir;
$this -> { m_Interpreter } = $interpreter;
return $this; # return Object
}
#/**
# Returns an instance of NetScript::Interpreter.
# @private
#*/
sub interpreter {
my ( $this ) = @_;
$this -> { m_Interpreter };
}
#/**
# Loads the given Library, if it has not yet been loaded.
# @param the name of the library.
#*/
sub loadLibrary {
my ( $this, $libName ) = @_;
#if lib is not yet loaded.
unless ( defined( $this -> { m_LoadedLibs } -> { $libName } ) ) {
# try to find the library.
my $filename = $this -> lookupLibrary( $this -> { m_BaseDir }, $libName );
if ( $filename ) {
my $perlLibName = $this -> getLibName( $filename );
unless( defined( $perlLibName ) ) {
$this -> interpreter() -> getEventRelay() ->
createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT,
"Cannot load library \"$libName\". The library contained no package statement!" );
}
unless ( defined( eval {
# load file
require $filename;
# import modules
import $perlLibName;
# create instance
my $libInstance = $perlLibName -> new();
# init instance
$libInstance -> init( $this -> interpreter() );
} ) ) {
$this -> interpreter() -> getEventRelay() ->
createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT,
"Cannot load library \"$libName\". $@" );
}
}
else {
$this -> interpreter() -> getEventRelay() ->
createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT,
"Cannot load library \"$libName\". Library not found!" );
}
}
}
#/**
# Searches for a given library in the given directory and
# returns the first occurence of a matching file. If
# no matching file could be found in the directory, all
# subdirectories are also searched. If the library cannot
# be found at all, returns undef. Else returns the filename,
# found.
# @param the base directory to start search from
# @param the name of the library.
#*/
sub lookupLibrary {
my ( $this, $dir, $library ) = @_;
my $libraryFile = $library."Library.pm";
opendir( DIR, $dir );
# search all files in the given directory which match the
# filename
my @files = grep { $_ eq $libraryFile && -f "$dir/$_" } readdir( DIR );
rewinddir( DIR );
my @subdirs = grep{ $_ ne "." && $_ ne ".." && -d "$dir/$_" } readdir( DIR );
closedir( DIR );
# if file could be found, then use it
my $result = shift @files;
if ( -f "$dir/$result" ) {
return "$dir/$result";
}
else {
# search subdirs
for ( @subdirs ) {
my $file = $this -> lookupLibrary( "$dir/$_", $library );
return $file if ($file ne "");
}
}
# no file found
return undef;
}
#/**
# Returns the perl module name of the module contained in the
# given filename.
# @param the filename to search.
# @retun the name of the package located in this file.
#*/
sub getLibName {
my ( $this, $filename ) = @_;
open( AFILE, "<$filename" );
while( <AFILE> ) {
if ( /package\s+([A-Za-z0-9_:]+)\s*;/ ) {
close( AFILE );
return $1;
}
}
close( AFILE );
return undef;
}
1; # make "require" happy
|
