[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries DateLibrary.pm,NONE,1.1

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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

Added Files:
	DateLibrary.pm 
Log Message:
* first implementation of a Date-library (not yet tested and possibly buggy)

--- NEW FILE: DateLibrary.pm ---
#--------------------------------------------------------
# $Id: DateLibrary.pm,v 1.1 2002/09/27 17:53:36 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 date and time operations.
# To load this library put the following statements into the netscript:
# <pre>
#       &lt;?netscript use Date?&gt;
# </pre>
# Add the following attribute to your document element:
# <pre>
#       &lt;yourdocumentelement xmlns:date=&quot;http://date.netscript.insomnia-hq.de&quot;/&gt;
# </pre>
# 
# The library adds a global TIME-object to the namespace. You can use it as
# as follows.
#  <pre>
#       $(TIME.now) - current time in milliseconds since 1.1.1970
#       $(TIME.year) - the current year ( 4 digit )
#       $(TIME.month) - the current month ( 1-12 )
#       $(TIME.day) - the current day in month ( 1-31 )
#       $(TIME.hour) - the current hour ( 0-23 )
#       $(TIME.minute) - the current minute ( 0-59 )
#       $(TIME.second) - the current second ( 0-59 )
#   </pre>
#
# You can roll the parts of a given date with the following function.
#   <pre>
#       &lt;date:roll {var|name}=&quot;&lt;variable&gt;&quot; date=&quot;&lt;date&gt;&quot; 
#               [year=&quot;&lt;amount&gt;&quot;] [month=&quot;&lt;amount&gt;&quot;] [day=&quot;&lt;amount&gt;&quot;]
#               [hour=&quot;&lt;amount&gt;&quot;] [minute=&quot;&lt;minute&gt;&quot;] [second=&quot;&lt;second&gt;&quot;]/&gt;
#   </pre>   
#   Rolls the given part of the date the given amount up or down and puts
#   the result into the &lt;variable&lt; specified. Please note that the roll-
#   function is far from being perfect. It takes care for leap years and
#   DST but is not very very advanced at it. 
#   If you have the time you might implement a better
#   version. (I could have used Date::Manip for this, however this module is
#   so damn big, its pretty useless in a web environment, since loading times
#   are too long .)
# @note The roll-function requires the Time::Local module!
#
# You can print out a date using the following function:
#   <pre>
#       &lt;date:format {var|name}=&quot;&lt;variable&gt;&quot; date=&quot;&lt;date&gt;&quot;
#           format=&quot;&lt;format&gt;&quot;/&gt;
#   </pre>
# This formats the given date into the given format string. The following 
# formats are known:
#   <ul>
#       <li>%y - year</li>
#       <li>%M - month</li>
#       <li>%d - day in month</li>
#       <li>%h - hour</li>
#       <li>%m - minute</li>
#       <li>%s - second</li>
#   </ul>
# 
#*/
package NetScript::Libraries::DateLibrary;
use base qw(NetScript::Libraries::Library);

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

use vars qw( $DATE_NAMESPACE_URI );

$DATE_NAMESPACE_URI="http://date.netscript.insomnia-hq.de";

#/**
# Ctor. 
# @public
#*/
sub new {
    my $proto = shift;                  # get Prototype
    my $class = ref($proto) || $proto;
    my $this = $class -> SUPER::new();
    $this;
    }

sub init {
    my ($this, $interpreter) = @_; date
    $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 $eventRelay = $this -> interpreter() -> getEventRelay();
    $eventRelay -> addEventListener( $eventListener1 );
    $eventRelay -> addEventListener( $eventListener2 );

    # register the time variable
    my $timeWrapper = NetScript::Engine::ClassWrapper -> new( $this );
    $timeWrapper -> setMember( '^now$', undef, "getNow" );
    $timeWrapper -> setMember( '^hour$', undef, "getHour" );
    $timeWrapper -> setMember( '^minute$', undef, "getMinute" );
    $timeWrapper -> setMember( '^second$', undef, "getSecond" );
    $timeWrapper -> setMember( '^day$', undef, "getDay" );
    $timeWrapper -> setMember( '^month$', undef, "getMonth" );
    $timeWrapper -> setMember( '^year$', undef, "getYear" );

    # register the TIME-object
    $this -> getStatementEvaluator() -> createVariable( "TIME", $timeWrapper );

    }

#/**
# Called upon element start
# @callback
#*/
sub elementStarted {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $DATE_NAMESPACE_URI ) {
        my $name = $node -> getLocalName();
        if ($name eq "roll") {
            $this -> doRoll( $node, $domWalker );
            0; # consume event
            }
        elsif ( $name eq "format" ) {
            $this -> doFormat( $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 $DATE_NAMESPACE_URI ) {
        my $name = $node -> getLocalName();
        if ($name eq "roll"  || $name eq "format") {
            0; # consume event 
            }
        else {
            1; # do not consume
            }
        }
    else {
        1; # do not consume event
        }
    }

#/**
# Rolls the given date parts and returns the result in the
# given variable.
# @param an instance of XML::DOM2::Element ( the roll-node )
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doRoll {
    my ( $this, $node, $domWalker ) = @_;
    my ( $create, $name ) = $this -> getVariableInfo( $node );
    my $se = $this -> interpreter() -> getStatementEvaluator();

    unless ( eval {
        use Time::Local 'timelocal_nocheck';
        1;
        } ) {
        $this -> interpreter() -> getEventRelay() ->
            createAndRaiseEvent( $NetScript::Interpreter::FATAL_EVENT,
            "The <date:roll>-function needs the Time::Local module to be installed!" );
    }

    my $date = $se -> evaluateStatement( $node -> getAttribute( "date" ) );
    my $format = $se -> evaluateStatement( $node -> getAttribute( "format" ) );

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
            localtime( $date );  

    my $secAdd = $se -> evaluateStatement( $node -> getAttribute( "second" ) );
    my $minAdd = $se -> evaluateStatement( $node -> getAttribute( "minute" ) );
    my $hourAdd = $se -> evaluateStatement( $node -> getAttribute( "hour" ) );
    my $dayAdd = $se -> evaluateStatement( $node -> getAttribute( "day" ) );
    my $monAdd = $se -> evaluateStatement( $node -> getAttribute( "month" ) );
    my $yearAdd = $se -> evaluateStatement( $node -> getAttribute( "year" ) );

    # XXX: the timelocal function doesnt work for months, so we have to roll 
    # ourselves. This might be a bit buggy and has to be replaced by a
    # better algorithm

    while ( $mon + $monAdd > 11 ) {
        $monAdd -= 12;
        $yearAdd ++;
        }

    while ( $mon + $monAdd < -11 ) {
        $monAdd += 12;
        $yearAdd --;
        }

    my $result = timelocal_nocheck(
            $sec + $secAdd,
            $min + $minAdd,
            $hour + $hourAdd,
            $mday + $dayAdd, 
            $mon + $monAdd ,
            $year + $yearAdd );

    if ( $create ) {
        $se -> createVariable( $name, $result );
        }
    else {
        $se -> setVariable( $name, $result );
        }

    $domWalker -> stepSourceNext();
    }

#/**
# Formats the given date and returns the result in the
# given variable.
# @param an instance of XML::DOM2::Element ( the format-node )
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doFormat {
    my ( $this, $node, $domWalker ) = @_;
    my ( $create, $name ) = $this -> getVariableInfo( $node );
    my $se = $this -> interpreter() -> getStatementEvaluator();

    my $date = $se -> evaluateStatement( $node -> getAttribute( "date" ) );
    my $format = $se -> evaluateStatement( $node -> getAttribute( "format" ) );

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
            localtime( $date );  

    $year += 1900;        
    $mon += 1;

    $format =~ s/%s/$sec/g;
    $format =~ s/%m/$min/g;
    $format =~ s/%h/$hour/g;
    $format =~ s/%d/$mday/g;
    $format =~ s/%M/$mon/g;
    $format =~ s/%y/$year/g;

    if ( $create ) {
        $se -> createVariable( $name, $format );
        }
    else {
        $se -> setVariable( $name, $format );
        }
    $domWalker -> stepSourceNext();
    }

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

sub getName {
    "Strings Library";
    }

sub getVersion {
    1.0;
    }

sub getDescription {
    "This Library provides string functions.";
    }
1; #make require happy