[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries DebugLibrary.pm,NONE,1.1 DefaultLibrary.pm,1.1,1.2 Library.pm,1.1,1.2

[Jan T. <de...@us...>]

Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries
In directory usw-pr-cvs1:/tmp/cvs-serv10237

Modified Files:
	DefaultLibrary.pm Library.pm 
Added Files:
	DebugLibrary.pm 
Log Message:
* added DebugLibrary
* several minor fixes

--- NEW FILE: DebugLibrary.pm ---
#--------------------------------------------------------
# $Id: DebugLibrary.pm,v 1.1 2002/05/11 13:09:03 derkork Exp $
#
# Class DebugLibrary
# 
# 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;

#/**
# The debug library catches debug-events and appends all debug
# message to the end of the document into a comment node.
#*/
package NetScript::Libraries::DebugLibrary;
use base qw(NetScript::Libraries::Library);

our $VERSION = '1.0';

our $DEBUG_EVENT = "DEBUG_LIBRARY_DEBUG_EVENT";

use NetScript::Engine::EventListener;
use NetScript::Engine::EventRelay;
use NetScript::Interpreter;
use NetScript::Engine::DOMWalker;

#/**
# Ctor. Creates a new DefaultLibrary Object.
# @public
#*/
sub new {
    my $proto = shift;                  # get Prototype
    my $class = ref($proto) || $proto;
    my $this = $class -> SUPER::new();
    $this -> { m_debug } = "\nDebug Messages:\n-----------------\n";
    $this;
    }


sub init {
    my ($this, $interpreter) = @_;
    $this -> SUPER::init( $interpreter );
    # create event listeners for all events

    my $eventListener1 = NetScript::Engine::EventListener -> new();
    $eventListener1 -> init( 
            $NetScript::Engine::DOMWalker::DOCUMENT_END_EVENT,
            "documentFinished", $this );

    my $eventListener2 = NetScript::Engine::EventListener -> new();
    $eventListener2 -> init( 
            $NetScript::Libraries::DebugLibrary::DEBUG_EVENT,
            "debugEvent", $this );
    my $eventRelay = $this -> interpreter() -> getEventRelay();
    $eventRelay -> addEventListener( $eventListener1 );
    $eventRelay -> addEventListener( $eventListener2 );
    }

#/**
# Called when the document is finished.
# @param an instance of <code>NetScript::Engine::Event</code>.
# @callback
#*/
sub documentFinished {
    my ( $this, $event ) = @_;
print "documentFinished!!";
    my $domWalker = $event -> eventUnknown();
    my $document = $domWalker -> currentSource() -> ownerDocument();
    my $comment = $document -> createComment( { 
            data => $this -> debugMessage() 
            } );
    $domWalker -> insertIntoTarget( $comment );
    1; #do not consume event
    }

#/**
# Called when a debug message has to be inserted. The message
# must be in the eventMessage - field. The eventUnknown-field
# should contain the sender of the event. Messages are 
# printed this way:
# <pre>
# [sender] message
# </pre>
# @param an instance of <code>NetScript::Engine::Event</code>.
# @callback
#*/
sub debugEvent {
    my ( $this, $event )  = @_;
    my $sender = $event -> eventUnknown();
    my $message = $event -> eventMessage();
    $this -> { m_debug } .= "[$sender] $message\n";
    0; # consume the event
    }

#/**
# Returns the debug message. Any sequence of 2 or more - is
# converted to 2 or more =.
# @private
#*/
sub debugMessage {
    my ($this) = @_;
    my $result = $this -> { m_debug };
    $result =~ s/(-[-]+)/"=" x length($1)/gex;
    $result;
    }

sub shutdown {
    my ($this) = @_;
    $this -> SUPER::shutdown();
    }

1; #make require happy


Index: DefaultLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DefaultLibrary.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** DefaultLibrary.pm	9 May 2002 19:12:16 -0000	1.1
--- DefaultLibrary.pm	11 May 2002 13:09:03 -0000	1.2
***************
*** 19,25 ****
  package NetScript::Libraries::DefaultLibrary;
  use base qw(NetScript::Libraries::Library);
- use vars qw($VERSION);
  
! $VERSION = '1.0';
  
  use NetScript::Engine::EventListener;
--- 19,24 ----
  package NetScript::Libraries::DefaultLibrary;
  use base qw(NetScript::Libraries::Library);
  
! our $VERSION = '1.0';
  
  use NetScript::Engine::EventListener;
***************
*** 49,85 ****
      my $eventListener1 = NetScript::Engine::EventListener -> new();
      $eventListener1 -> init( 
!             NetScript::Engine::DOMWalker -> ELEMENT_START_EVENT(),
              "elementStarted", $this, 
!             NetScript::Engine::EventListener -> PRIORITY_LAST() );
  
      my $eventListener2 = NetScript::Engine::EventListener -> new();
      $eventListener2 -> init( 
!             NetScript::Engine::DOMWalker -> PI_EVENT(),
              "copyNode", $this, 
!             NetScript::Engine::EventListener -> PRIORITY_LAST() );
                  
      my $eventListener3 = NetScript::Engine::EventListener -> new();
      $eventListener3 -> init( 
!             NetScript::Engine::DOMWalker -> TEXT_EVENT(),
              "copyNode", $this, 
!             NetScript::Engine::EventListener -> PRIORITY_LAST() );
      
      my $eventListener4 = NetScript::Engine::EventListener -> new();
      $eventListener4 -> init( 
!             NetScript::Engine::DOMWalker -> COMMENT_EVENT(),
              "copyNode", $this, 
!             NetScript::Engine::EventListener -> PRIORITY_LAST() );
  
      my $eventListener5 = NetScript::Engine::EventListener -> new();
      $eventListener5 -> init( 
!             NetScript::Engine::DOMWalker ->OTHER_NODE_EVENT(),
              "copyNode", $this, 
!             NetScript::Engine::EventListener -> PRIORITY_LAST() );
  
      my $eventListener6 = NetScript::Engine::EventListener -> new();
      $eventListener6 -> init( 
!             NetScript::Engine::DOMWalker -> ELEMENT_END_EVENT(),
              "elementFinished", $this, 
!             NetScript::Engine::EventListener -> PRIORITY_LAST() );
  
      my $eventRelay = $this -> interpreter() -> getEventRelay();
--- 48,84 ----
      my $eventListener1 = NetScript::Engine::EventListener -> new();
      $eventListener1 -> init( 
!             $NetScript::Engine::DOMWalker::ELEMENT_START_EVENT,
              "elementStarted", $this, 
!            $NetScript::Engine::EventListener::PRIORITY_LAST );
  
      my $eventListener2 = NetScript::Engine::EventListener -> new();
      $eventListener2 -> init( 
!             $NetScript::Engine::DOMWalker::PI_EVENT,
              "copyNode", $this, 
!            $NetScript::Engine::EventListener::PRIORITY_LAST );
                  
      my $eventListener3 = NetScript::Engine::EventListener -> new();
      $eventListener3 -> init( 
!             $NetScript::Engine::DOMWalker::TEXT_EVENT,
              "copyNode", $this, 
!            $NetScript::Engine::EventListener::PRIORITY_LAST );
      
      my $eventListener4 = NetScript::Engine::EventListener -> new();
      $eventListener4 -> init( 
!             $NetScript::Engine::DOMWalker::COMMENT_EVENT,
              "copyNode", $this, 
!            $NetScript::Engine::EventListener::PRIORITY_LAST );
  
      my $eventListener5 = NetScript::Engine::EventListener -> new();
      $eventListener5 -> init( 
!             $NetScript::Engine::DOMWalker::OTHER_NODE_EVENT,
              "copyNode", $this, 
!            $NetScript::Engine::EventListener::PRIORITY_LAST );
  
      my $eventListener6 = NetScript::Engine::EventListener -> new();
      $eventListener6 -> init( 
!             $NetScript::Engine::DOMWalker::ELEMENT_END_EVENT,
              "elementFinished", $this, 
!            $NetScript::Engine::EventListener::PRIORITY_LAST );
  
      my $eventRelay = $this -> interpreter() -> getEventRelay();
***************
*** 88,94 ****
      $eventRelay -> addEventListener( $eventListener3 );
      $eventRelay -> addEventListener( $eventListener4 );
- # Test - should double all comments...
- #    $eventRelay -> addEventListener( $eventListener4 );
- 
      $eventRelay -> addEventListener( $eventListener5 );
      $eventRelay -> addEventListener( $eventListener6 );
--- 87,90 ----
***************
*** 98,102 ****
  # Copies the current node.
  # @param an instance of <code>NetScript::Engine::Event</code>
! # @public
  #*/
  sub copyNode {
--- 94,98 ----
  # Copies the current node.
  # @param an instance of <code>NetScript::Engine::Event</code>
! # @callback
  #*/
  sub copyNode {
***************
*** 105,109 ****
      my $node = $domWalker -> currentSource();
      $domWalker -> insertIntoTarget( $node, 1 );
!     1; # consume event
      }
  
--- 101,105 ----
      my $node = $domWalker -> currentSource();
      $domWalker -> insertIntoTarget( $node, 1 );
!     0; # consume event
      }
  
***************
*** 111,115 ****
  # Called when an element starts.
  # @param an instance of <code>NetScript::Engine::Event</code>
! # @public
  #*/
  sub elementStarted {
--- 107,111 ----
  # Called when an element starts.
  # @param an instance of <code>NetScript::Engine::Event</code>
! # @callback
  #*/
  sub elementStarted {
***************
*** 119,123 ****
      push( @{$this -> { m_elemStack }}, $id );
      $this -> copyNode( $event );
!     1; # consume event
      }
  
--- 115,119 ----
      push( @{$this -> { m_elemStack }}, $id );
      $this -> copyNode( $event );
!     0; # consume event
      }
  
***************
*** 125,129 ****
  # Called when an element ends.
  # @param an instance of <code>NetScript::Engine::Event</code>
! # @public
  #*/
  sub elementFinished {
--- 121,125 ----
  # Called when an element ends.
  # @param an instance of <code>NetScript::Engine::Event</code>
! # @callback
  #*/
  sub elementFinished {
***************
*** 134,138 ****
      $domWalker -> currentTarget( $node );
      $domWalker -> clearMark( $id );
!     1; # consume event
      }
  
--- 130,134 ----
      $domWalker -> currentTarget( $node );
      $domWalker -> clearMark( $id );
!     0; # consume event
      }
  

Index: Library.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/Library.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Library.pm	9 May 2002 19:12:16 -0000	1.1
--- Library.pm	11 May 2002 13:09:03 -0000	1.2
***************
*** 20,26 ****
  #*/
  package NetScript::Libraries::Library;
- use vars qw($VERSION);
  
! $VERSION = '1.0';
  
  #/**
--- 20,26 ----
  #*/
  package NetScript::Libraries::Library;
  
! 
! our $VERSION = '1.0';
  
  #/**