From: Jan T. <de...@us...> - 2002-08-21 10:35:49
|
Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries In directory usw-pr-cvs1:/tmp/cvs-serv16479 Added Files: FilesLibrary.pm Log Message: * new library for reading and writing files --- NEW FILE: FilesLibrary.pm --- #-------------------------------------------------------- # $Id: FilesLibrary.pm,v 1.1 2002/08/21 10:35:46 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 library adds support for file operations. # To load this library put the following statements into the netscript: # <pre> # <?netscript use Files?> # </pre> # Add the following attribute to your document element: # <pre> # <yourdocumentelement xmlns:str="http://files.netscript.insomnia-hq.de"/> # </pre> # <pre> # <files:redirect-output filename="{filename}" # [append="yes|no"] # [toOutput="yes|no"]> # <any><code><here></here></code></any> # </files:redirect-output> # </pre> # Redirects all output between the tag to the given file. If toOutput is # set to "yes", the output will also be routed to the # standard output (most often the browser), else it will be just put into # the file and not be sent to the browser. # Note that the file is locked exclusively for the redirect. # If append is set to "yes" the output will be appended to the file, instead # of replacing the original content of the file. # <pre> # <files:open filename="{filename}" handle="{name of the filehandle}" # mode="{r|w|a|rw}" [lock="{shared|exclusive}]"> # <any><file><operation><here></here></operation></file></any> # </file:open> # </pre> # Opens the given file and assigns it to the given handle. You can set # the mode to read ("r"), write ("w"), append("a") or read and write ("rw"). # As an optional argument you can tell if the file should be locked either # in shared mode ( that means, other processes can read but not write ) or # exclusive mode( that means, other processes can neither read nor write ). # File will be closed when the closing open-tag is reached. Note that using # one of the writing modes, the file will be created if necessary. If # using the "w"-mode, file will be truncated to zero length before writing. # Note that if using the locking modes, the command will block until a lock # has been established. # <pre> # <files:read handle="{name of the filehandle}" bytes="{a number}" # name|var="{variable name}"/> # </pre> # Reads the specified number of bytes from the given file. If the file end # is encountered, then reading will stop there. Read contents will be put # into the given variable. # <pre> # <files:readlns handle="{name of the filehandle}" # name|var="{variable name}" # [lines="{number of lines to read}"] # [from="{index in array where to start}"]/> # </pre> # Reads the specified number of lines from the file and puts them into an array. # If the lines-attribute is omitted, it reads all lines from the file into # the array. The from attribute specifies, at which index in the array the # read lines should start. If omitted, 0 is assumed. # <pre> # <files:write handle="{name of the filehandle}" # var="{variable name}"/> # </pre> # Writes the content of the given variable to the given file. If variable # is an array, all array members will be written to the file. # #*/ package NetScript::Libraries::FilesLibrary; use base qw(NetScript::Libraries::Library); use NetScript::Engine::EventListener; use NetScript::Engine::EventRelay; use NetScript::Interpreter; use NetScript::Engine::DOMWalker; use XML::DOM2::DOMWriter; use XML::DOM2::PlainXMLDOMWriterStyle; use vars qw( $FILES_NAMESPACE_URI ); $FILES_NAMESPACE_URI="http://files.netscript.insomnia-hq.de"; #/** # Ctor. # @public #*/ sub new { my $proto = shift; # get Prototype my $class = ref($proto) || $proto; my $this = $class -> SUPER::new(); my %openFiles = (); my @redirectNodes = (); my @processedNodes = (); $this -> { m_openFiles } = \%openFiles; $this -> { m_redirectNodes } = \@redirectNodes; $this -> { m_processedNodes } = \@processedNodes; $this -> { m_isRedirectOpen } = 0; $this; } sub init { my ($this, $interpreter) = @_; $this -> SUPER::init( $interpreter ); # register event listeners for the cookie-tag my $eventListener1 = NetScript::Engine::EventListener -> new(); $eventListener1 -> init( $NetScript::Engine::DOMWalker::ELEMENT_START_EVENT, "elementStarted", $this ); my $eventListener2 = NetScript::Engine::EventListener -> new(); $eventListener2 -> init( $NetScript::Engine::DOMWalker::ELEMENT_END_EVENT, "elementFinished", $this ); my $eventListener3 = NetScript::Engine::EventListener -> new(); $eventListener3 -> init( $NetScript::Engine::DOMWalker::DOCUMENT_END_EVENT, "documentFinished", $this ); my $eventRelay = $this -> interpreter() -> getEventRelay(); $eventRelay -> addEventListener( $eventListener1 ); $eventRelay -> addEventListener( $eventListener2 ); $eventRelay -> addEventListener( $eventListener3 ); } #/** # Returns the name of the filehandle, specified on the # given node. Throws an error if no filehandle is specified # on the given node. # @private # @param the node to scan # @return the file handle #*/ sub getFileHandle { my ( $this, $node ) = @_; my $se = $this -> interpreter() -> getStatementEvaluator(); my $handleName = $node -> getAttribute( "handle" ); $handleName = $se -> evaluateStatement( $handleName ); if ( $handleName eq "" ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "You did not specify a file handle!"); } $handleName; } #/** # Opens the given file. # @param an instance of XML::DOM2::Element # @param an instance of NetScript::Engine::DOMWalker #*/ sub doOpen { my ( $this, $node, $domWalker ) = @_; my $se = $this -> interpreter() -> getStatementEvaluator(); my $handle = $this -> getFileHandle( $node ); my $mode = $node -> getAttribute( "mode" ); my $locking = $node -> getAttribute( "lock" ); my $filename = $node -> getAttribute( "filename" ); $mode = $se -> evaluateStatement( $mode ); $locking = $se -> evaluateStatement( $locking ); $filename = $se -> evaluateStatement( $filename ); if ( $filename eq "" ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "You must specify a filename." ); } my $filehandle = $this -> { m_openFiles } -> { $handle }; if ( defined( $filehandle ) ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "The handle \"$handle\" is already in use. Use another one." ); } # open file in requested mode if ( $mode eq "r" ) { open( $filehandle, "<$filename" ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Unable to open \"$filename\" for reading, maybe it doesnt exist or lacks the necessary permissions." ); } elsif ( $mode eq "w" ) { open( $filehandle, ">$filename" ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Unable to open \"$filename\" for writing, maybe it lacks the necessary permissions." ); } elsif ( $mode eq "a") { open( $filehandle, ">>$filename" ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Unable to open \"$filename\" for appending, maybe it lacks the necessary permissions." ); } elsif ( $mode eq "rw" ) { open( $filehandle, "+<$filename" ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Unable to open \"$filename\" for read/write, maybe it doesn't exist orlacks the necessary permissions." ); } else { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, $mode eq "" ? "You must specify an opening mode!" : "Unknown opening mode \"$mode\". Specify one of \"r\", \"w\", \"rw\" or \"a\"!" ); } # Do file lock if requested if ( $locking eq "shared" ) { # Shared lock = 1 flock( $filehandle, 1 ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot acquire a shared lock on $filename!" ); } elsif ( $locking eq "exclusive" ) { # Exclusive lock = 2 flock ( $filehandle, 2 ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot acquire an exclusive lock on $filename!" ); } $this -> { m_openFiles } -> { $handle } = $filehandle; $domWalker -> stepSourceIn(); } #/** # Writes to the open file with the given handle. # @param an instance of XML:DOM2::Element # @param an instance of NetScript::Engine::DOMWalker #*/ sub doWrite { my ( $this, $node, $domWalker ) = @_; my $se = $this -> interpreter() -> getStatementEvaluator(); my $handle = $this -> getFileHandle( $node ); my $variable = $node -> getAttribute( "var" ); if ( $variable eq "" ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "You did not specify a variable!" ); } my $fileHandle = $this -> { m_openFiles } -> { $handle }; if ( ! defined( $fileHandle ) ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "There is no filehandle \"$handle\"!" ); } my $value = $se -> resolveObjectValue( $variable ); print { $fileHandle } $value; $domWalker -> stepSourceNext(); } #/** # Reads from the open file with the given file handle. # @param an instance of XML:DOM2::Element # @param an instance of NetScript::Engine::DOMWalker #*/ sub doRead { my ( $this, $node, $domWalker ) = @-; my $se = $this -> interpreter() -> getStatementEvaluator(); my $handle = $this -> getFileHandle( $node ); my ($create, $variable) = $this -> getVariableInfo( $node ); my $length = $se -> evaluateStatement( $node -> getAttribute( "bytes" ) ); unless( $length =~ /^[0-9]+$/ ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Invalid value for bytes : \"$length\"!" ); } my $fileHandle = $this -> { m_openFiles } -> { $handle }; if ( ! defined( $fileHandle ) ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "There is no filehandle \"$handle\"!" ); } my $value; # read from file read( $fileHandle, $value, $length ); # set variable if ( $create ) { $se -> createVariable( $variable, $value ); } else { $se -> setVariable( $variable, $value ); } $domWalker -> stepSourceNext(); } #/** # Reads the specified number of lines from the given file # @param an instance of XML:DOM2::Element # @param an instance of NetScript::Engine::DOMWalker #*/ sub doReadlns { my ( $this, $node, $domWalker ) = @_; my $se = $this -> interpreter() -> getStatementEvaluator(); my $handle = $this -> getFileHandle( $node ); my ($create, $variable) = $this -> getVariableInfo( $node ); my $count = $se -> evaluateStatement( $node -> getAttribute( "lines" ) ); my $index = $se -> evaluateStatement( $node -> getAttribute( "from" ) ); my $fileHandle = $this -> { m_openFiles } -> { $handle }; if ( ! defined( $fileHandle ) ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "There is no filehandle \"$handle\"!" ); } if ( $create ) { $se -> createVariable( "$variable:!" ); } if ( $index eq "" ) { $index = 0; } if ( $count eq "" ) { my $idx = $index; while( <$fileHandle> ) { $se -> setVariable( "$variable:$idx", $_ ); $idx ++; } } else { my $idx = $index; my $read = 0; while ( $read < $count ) { my $val = <$fileHandle>; if ( $val ) { $se -> setVariable( "$variable:$idx", $val ); $idx ++; $read ++; } else { last; } } } $domWalker -> stepSourceNext(); } #/** # Saves the output-tag so output can be redirected later. # #*/ sub doRedirectOutput { my ( $this, $node, $domWalker ) = @_; if ( $this -> { m_isRedirectOpen } ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "You must not nest \"redirect-output\" tags!" ); } $this -> { m_isRedirectOpen } = 1; my $se = $this -> interpreter() -> getStatementEvaluator(); my $filename = $se -> evaluateStatement( $node -> getAttribute( "filename" ) ); if ( $filename eq "" ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "You must specify a filename to export to!" ); } my $targetNode = $domWalker -> insertIntoTarget( $node, 1 ); push( @{ $this -> { m_redirectNodes } }, $targetNode ); push( @{ $this -> { m_processedNodes } }, $targetNode ); $domWalker -> stepSourceIn(); } #/** # Called when redirect-output ends. #*/ sub doRedirectOutputFinish { my ( $this, $aNode, $domWalker ) = @_; my $se = $this -> interpreter() -> getStatementEvaluator(); my $domWriter = XML::DOM2::DOMWriter -> new(); my $style = XML::DOM2::PlainXMLDOMWriterStyle -> new(); my $node = pop( @{ $this -> { m_redirectNodes } } ); my $filename = $se -> evaluateStatement( $node -> getAttribute( "filename" ) ); my $append = $se -> evaluateStatement( $node -> getAttribute( "append" ) ); open( AFILE, $append eq "yes" ? ">>$filename" : ">$filename" ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot open \"$filename\". Maybe it lacks the necessary permissions." ); flock( AFILE, 2 ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot lock \"$filename\"." ); my $children = $node -> getChildNodes(); my $len = $children -> getLength() - 1; for ( 0..$len ) { my $child = $children -> item( $_ ); my $value = $domWriter -> writeDOMToString( $child, $style ); print AFILE $value; } flock( AFILE, 8 ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot unlock \"$filename\"." ); close( AFILE ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot close \"$filename\"!" ); $this -> { m_isRedirectOpen } = 0; $domWalker -> stepTargetUp(); } #/** # Closes the open file. # @param an instance of XML:DOM2::Element # @param an instance of NetScript::Engine::DOMWalker #*/ sub doClose { my ( $this, $node, $domWalker ) = @_; my $handle = $this -> getFileHandle( $node ); my $fileHandle = $this -> { m_openFiles } -> { $handle }; if ( ! defined( $fileHandle ) ) { $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "There is no filehandle \"$handle\"!" ); } my $lock = $node -> getAttribute( "lock" ); if ( $lock ne "" ) { flock( $fileHandle, 8 ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot unlock file with handle \"$handle\"!" ); } close( $fileHandle ) or $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT, "Cannot close the file with handle \"$handle\"!" ); delete $this -> { m_openFiles } -> { $handle }; } #/** # Called upon element start # @callback #*/ sub elementStarted { my ( $this, $event ) = @_; my $domWalker = $event -> getEventUnknown(); my $node = $domWalker -> currentSource(); if ( $node -> getNamespaceURI() eq $FILES_NAMESPACE_URI ) { my $name = $node -> getLocalName(); if ( $name eq "open" ) { $this -> doOpen( $node, $domWalker ); 0; } elsif ( $name eq "read" ) { $this -> doRead( $node, $domWalker ); 0; } elsif ( $name eq "write" ) { $this -> doWrite( $node, $domWalker ); 0; } elsif ( $name eq "readlns" ) { $this -> doReadlns( $node, $domWalker ); 0; } elsif ( $name eq "redirect-output" ) { $this -> doRedirectOutput( $node, $domWalker ); 0; } else { 1; # do not consume event } } else { 1; # do not consume event } } #/** # Called upon element finish. # @callback #*/ sub elementFinished { my ( $this, $event ) = @_; my $domWalker = $event -> getEventUnknown(); my $node = $domWalker -> currentSource(); if ( $node -> getNamespaceURI() eq $FILES_NAMESPACE_URI ) { my $name = $node -> getLocalName(); if ($name eq "read" || $name eq "readlns" || $name eq "write" || $name eq "seek" ) { 0; # consume event } elsif ( $name eq "open" ) { $this -> doClose( $node, $domWalker ); 0; } elsif ( $name eq "redirect-output" ) { $this -> doRedirectOutputFinish( $node, $domWalker ); 0; } else { 1; # do not consume } } else { 1; # do not consume event } } #/** # The document is finished, now we can do our remaining output. #*/ sub documentFinished { my ( $this, $event ) = @_; my $domWalker = $event -> getEventUnknown(); my @nodes = @{ $this -> { m_processedNodes } }; my $se = $this -> interpreter() -> getStatementEvaluator(); for ( @nodes ) { my $node = $_; my $export = $se -> evaluateStatement( $node -> getAttribute( "toOutput" ) ); if ( $export eq "yes" ) { my $parent = $node -> getParentNode(); my $children = $node -> getChildNodes(); my $len = $children -> getLength() -1; # parent node must be an element if ( defined( $node ) && $node -> getNodeType() == $XML::DOM2::Node::ELEMENT_NODE ) { for ( 0..$len ) { my $child = $children -> item( 0 ); $parent -> insertBefore( $child, $node ); } $parent -> removeChild( $node ); } # XXX: A bit strange but what should i do ? # else keep it that way... } else { # Remove node from target document my $parent = $node -> getParentNode(); $parent -> removeChild( $node ); } } 1; # do not consume! } sub shutdown { my ($this) = @_; $this -> SUPER::shutdown(); } sub getName { "Files Library"; } sub getVersion { 1.0; } sub getDescription { "This Library provides file functions."; } 1; #make require happy |