From: Jan T. <de...@us...> - 2002-06-02 19:31:25
|
Update of /cvsroot/net-script/netscript2/src/perl/NetScript In directory usw-pr-cvs1:/tmp/cvs-serv570 Modified Files: Interpreter.pm Log Message: * added library include facility * moved Wrappers to Engine * added emergency error page (if error page is missing) * changed configfilereader to be more generic * some performance improvements * overall bugfixing Index: Interpreter.pm =================================================================== RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Interpreter.pm,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Interpreter.pm 15 May 2002 18:24:27 -0000 1.7 --- Interpreter.pm 2 Jun 2002 19:31:23 -0000 1.8 *************** *** 17,42 **** #*/ package NetScript::Interpreter; ! ! #-------------------------------------------------------- ! # IMPORTS ! #-------------------------------------------------------- ! use CGI; ! use XML::Parser; ! use NetScript::Engine::State; ! use NetScript::Engine::DOMWalker; ! use NetScript::Engine::Event; ! use NetScript::Engine::EventRelay; ! use NetScript::Engine::StatementEvaluator; ! use NetScript::Libraries::DefaultLibrary; ! use NetScript::Libraries::DebugLibrary; ! use NetScript::Libraries::ControlStructuresLibrary; ! use NetScript::Util::XMLParserRelay; ! use NetScript::Util::FileRetriever; ! use NetScript::Util::ConfigurationParser; ! use NetScript::Util::UIDGenerator; ! use XML::DOM2::DOMParser; ! use XML::DOM2::DOMWriter; ! use XML::DOM2::XMLDOMWriterStyle; ! #----------------------------------------------------------- --- 17,21 ---- #*/ package NetScript::Interpreter; ! use vars qw( $VERSION $NAMESPACE_URI $FATAL_EVENT $WARNING_EVENT ); #----------------------------------------------------------- *************** *** 46,50 **** # The current Version of NetScript #*/ ! our $VERSION = '2.0 ($Date$)'; #/** --- 25,29 ---- # The current Version of NetScript #*/ ! $VERSION = '2.0pre1'; #/** *************** *** 52,60 **** # (http://netscript.insomnia-hq.de). #*/ ! our $NAMESPACE_URI = "http://netscript.insomnia-hq.de"; # This is for catching errors at compile-time use CGI::Carp qw(fatalsToBrowser set_message); BEGIN { sub handle_errors { --- 31,53 ---- # (http://netscript.insomnia-hq.de). #*/ ! $NAMESPACE_URI = "http://netscript.insomnia-hq.de"; ! + #/** + # This event can be raised by libraries if a fatal condition + # arises. + #*/ + $FATAL_EVENT = "INTERPRETER_FATAL_EVENT"; + + #/** + # This event can be raised by libraries if a warning condition + # arises. + #*/ + $WARNING_EVENT = "INTERPRETER_WARNING_EVENT"; # This is for catching errors at compile-time use CGI::Carp qw(fatalsToBrowser set_message); + use NetScript::Util::ConfigurationParser; + BEGIN { sub handle_errors { *************** *** 62,75 **** my $parser = NetScript::Util::ConfigurationParser -> new(); ! open( AFILE, "<".$parser -> staticDir()."/pages/errorpage.html" ); my $msg = ""; ! while(<AFILE>) { ! $msg .= $_; } - close( AFILE ); $msg =~ s/<message>/$message/xeg; $msg =~ s/<version>/$VERSION/xeg; print $msg; } set_message(\&handle_errors); --- 55,80 ---- my $parser = NetScript::Util::ConfigurationParser -> new(); ! my $staticDir = $parser -> getSetting( "STATIC" ); ! my $staticURL = $parser -> getSetting( "STATIC_URL" ); my $msg = ""; ! if ( -e $staticDir."/errorpage.html" ) { ! open( AFILE, "<".$staticDir."/errorpage.html" ); ! while(<AFILE>) { ! $msg .= $_; ! } ! close( AFILE ); ! } ! else { ! $msg = "An error occured: <br><pre><message></pre>.<br><b>Warning: could not find". ! " the error page. It is set to \"<staticdir>/errorpage.html\", but this file does not exist!</b>"; } $msg =~ s/<message>/$message/xeg; $msg =~ s/<version>/$VERSION/xeg; + $msg =~ s/<staticdir>/$staticDir/xeg; + $msg =~ s/<staticurl>/$staticURL/xeg; + print $msg; + set_message(""); } set_message(\&handle_errors); *************** *** 77,80 **** --- 82,104 ---- + #-------------------------------------------------------- + # IMPORTS + #-------------------------------------------------------- + use CGI; + use XML::Parser; + use NetScript::Engine::State; + use NetScript::Engine::DOMWalker; + use NetScript::Engine::Event; + use NetScript::Engine::EventRelay; + use NetScript::Engine::StatementEvaluator; + use NetScript::Engine::LibLoader; + use NetScript::Engine::ClassWrapper; + use NetScript::Util::XMLParserRelay; + use NetScript::Util::FileRetriever; + use NetScript::Util::UIDGenerator; + use XML::DOM2::DOMParser; + use XML::DOM2::DOMWriter; + use XML::DOM2::XMLDOMWriterStyle; + #/** # Constructor of a new Interpreter. *************** *** 101,117 **** $this -> { m_currentState } = NetScript::Engine::State -> new(); ! my $defLib = NetScript::Libraries::DefaultLibrary -> new(); ! $defLib -> init( $this ); ! ! my $debugLib = NetScript::Libraries::DebugLibrary -> new(); ! $debugLib -> init( $this ); ! my $csLib = NetScript::Libraries::ControlStructuresLibrary -> new(); ! $csLib -> init( $this ); return $this; # return Object } #/** # Returns a unique ID, generated by <code>NetScript::Util::UIDGenerator</code> --- 125,202 ---- $this -> { m_currentState } = NetScript::Engine::State -> new(); + $this -> { m_ScriptURL } = undef; ! my $eventListener = NetScript::Engine::EventListener -> new(); ! $eventListener -> init( $FATAL_EVENT, "onFatalEvent", $this, ! $NetScript::Engine::EventListener::PRIORITY_FIRST ); ! $this -> getEventRelay() -> addEventListener( $eventListener ); ! ! my @cookieList = (); ! $this -> { m_Cookies } = \@cookieList; ! ! my $libLoader = NetScript::Engine::LibLoader -> new( $this, "NetScript/Libraries" ); ! $this -> { m_LibLoader } = $libLoader; ! ! $libLoader -> loadLibrary( "Default" ); ! $libLoader -> loadLibrary( "Debug" ); ! $libLoader -> loadLibrary( "ControlStructures" ); ! $libLoader -> loadLibrary( "Variables" ); ! $libLoader -> loadLibrary( "Forms" ); ! my $systemWrapper = NetScript::Engine::ClassWrapper -> new( $this ); ! $systemWrapper -> setMember( '^interpreterURL$', undef, "getInterpreterURL" ); ! $systemWrapper -> setMember( '^scriptURL$', undef, "getScriptURL" ); ! ! # register the SYS-object ! $this -> getState() -> setObjectValue( "SYS", $systemWrapper ); return $this; # return Object } + + #/** + # Returns an instance of NetScript::Engine::LibLoader. + #*/ + sub getLibLoader { + my ( $this ) = @_; + $this -> { m_LibLoader }; + } + + #/** + # Returns the URL of the interpreter. + # @callback + #*/ + sub getInterpreterURL { + my ( $this ) = @_; + $this -> getCGI() -> url(); + } + + #/** + # Returns the URL of the script. + # @callback + #*/ + sub getScriptURL { + my ( $this ) = @_; + $this -> { m_ScriptURL }; + } + + #/** + # Sets a cookie in the outgoing response. Since cookies have + # to be set in the http-header, to which libraries have no access + # the cookie settings have been centralized in the Interpreter + # class. Cookie retrieval can be done using the CGI-Object which + # is available from the Interpreter. + # @param name of the cookie + # @param value of the cookie + # @param cookie expire time ( e.g +5h ) + #*/ + sub setCookie { + my ( $this, $name, $value, $expires ) = @_; + my $cookie = $this -> getCGI() -> cookie( + -name=>$name, -value=>$value, -expires=>$expires + ); + push( @{ $this -> { m_Cookies} }, $cookie ); + } + #/** # Returns a unique ID, generated by <code>NetScript::Util::UIDGenerator</code> *************** *** 148,157 **** # start input file parsing my $domparser = XML::DOM2::DOMParser -> new(); ! my $dom = $domparser -> parseString( { string => $this -> getFileRetriever() -> retrieveFile( ! "file:./test.xml" ) } ); # Create a DOMWalker --- 233,258 ---- + my $script = $this -> getParameter( "script" ); + if ( $script eq "" ) { + $script = $this -> getParameter( "scriptURL" ); + } + else { + $script = "file:" . $script; + } + + + if ( $script eq "" ) { + $this -> getEventRelay() -> createAndRaiseEvent( + $FATAL_EVENT, + "No script was given! Use the script or scriptURL-parameter!" ); + } + + $this -> { m_ScriptURL } = $script; + my $scriptContent = $this -> getFileRetriever() -> retrieveFile( $script ); # start input file parsing my $domparser = XML::DOM2::DOMParser -> new(); ! my $dom = $domparser -> parseString( { string => $scriptContent } ); # Create a DOMWalker *************** *** 167,171 **** style => $domstyle } ); ! print $this -> getCGI() -> header(); print $string; --- 268,273 ---- style => $domstyle } ); ! my $cookiesRef = $this -> { m_Cookies }; ! print $this -> getCGI() -> header( -cookie=>$cookiesRef ); print $string; *************** *** 184,193 **** # @return a string containing the value(s) of the parameter # or undef, if the parameter was not specified. ! # @public #*/ sub getParameter { my ($this, $parameter) = @_; ! my $result = $this -> getCGI() -> param( $parameter ); ! return $result; } --- 286,294 ---- # @return a string containing the value(s) of the parameter # or undef, if the parameter was not specified. ! # @private #*/ sub getParameter { my ($this, $parameter) = @_; ! $this -> getCGI() -> param( $parameter ); } *************** *** 272,277 **** sub onFatalEvent { my ($this, $event ) = @_; ! die $event -> getEventMessage(); } 1; # make "require" happy --- 373,394 ---- sub onFatalEvent { my ($this, $event ) = @_; ! die $event -> eventMessage(); } + + #/** + # Sends a debug event. + # @param the debug message + # @private + #*/ + sub debug { + my ($this, $message) = @_; + $this -> getEventRelay() -> + createAndRaiseEvent( + $NetScript::Libraries::DebugLibrary::DEBUG_EVENT, + $message, + "[Interpreter]" + ); + } + 1; # make "require" happy |