File Coverage

blib/lib/StateML/Arc.pm

Criterion	Covered	Total	%
statement	23	85	27.0
branch	6	56	10.7
condition	2	6	33.3
subroutine	7	19	36.8
pod	7	15	46.6
total	45	181	24.8

package StateML::Arc ;

use strict ;

use base qw(StateML::Object ) ;

use StateML::Utils qw( empty );
use Carp qw( confess );

=head1 NAME

StateML::Arc - A transition between states

=head1 DESCRIPTION

An arc is a transition between states; they occur by default or
on certain events.

A loopback arc is an arc that transits from a state back to itself.

Arcs can have handlers, either explicitly using one or more s or
by reference to an  using an action-id attribute (we need to
allow arcs to have multiple actions at some point).

Arcs can contain an , in which case the 's event-id= is
automatically read from the  (which in turn may omit it and let
StateML::Machine assign one).

=head2 Default from/to state ids.

On parsing,  elements may appear in  elements.  When they
do, the from= and/or to= attributes may be omitted; they will default to
the parent state's id.

=head1 METHODS (incomplete, see the source, luke)

=over

=cut

=item event

Returns the event for this arc, if set.

=cut

sub event {
    my $self = shift;

    $self->event_id( $_[0]->id ) if @_;

    return unless defined wantarray;

    my $event_id = $self->event_id;
    return undef unless defined $event_id;

    confess "arc is not in a machine, can't fetch the event"
        unless $self->machine;

    my $event = $self->machine->event_by_id( $event_id );

    confess "event ", as_str( $event_id ), " is not in machine"
        unless $event;

    return $event;
}

=item event_id

Returns the event_id if set.  If not set (undef), returns the default event's
ID if it is present in the machine.  Note that "" is a I valid id.

=cut

sub event_id {
    my $self = shift ;

    $self->{EVENT_ID} = shift if @_ ;
    return $self->{EVENT_ID} if defined $self->{EVENT_ID};

    my $default_event =
        $self->machine && $self->machine->event_by_id( "#DEFAULT" );

    return $default_event ? $default_event->id : undef;
}

=item name

Returns the name if set.  If not set, returns the name of the event_id
event (if that's set).  Note that "" I a valid name.

=cut

sub name {
    my $self = shift;

    $self->SUPER::name( @_ ) if @_;
    return $self->{NAME} if defined $self->{NAME};

    my $event = $self->event if $self->machine;

    return $event->name;
}

sub from {
    my $self = shift ;
    $self->{FROM} = shift if @_ ;
    return $self->{FROM} ;
}

sub to {
    my $self = shift ;
    $self->{TO} = shift if @_ ;
    return $self->{TO} ;
}

sub guard {
    my $self = shift ;
    $self->{GUARD} = shift if @_ ;
    return $self->{GUARD} ;
}

sub from_state {
    my $self = shift ;
    $self->{FROM} = shift()->id if @_ ;
    return $self->machine->state_by_id( $self->{FROM} ) ;
}

sub to_state {
    my $self = shift ;
    $self->{TO} = shift()->id if @_ ;
    return $self->machine->state_by_id( $self->{TO} ) ;
}

sub description {
    my $self = shift ;
    $self->{DESCRIPTION} = shift if @_ ;
    return $self->{DESCRIPTION};
}

sub handlers {
    my $self = shift ;
    $self->{HANDLERS} = @_ if @_ ;
    return map ref $_
        ? do {
            my $action = $self->machine->action_by_id( $$_ );
            die "Action $$_ for arc ",
                $self->name,
                " (id ",
                $self->id,
                ") not defined\n"
                unless $action;
            $action->handlers;
        }
        : $_,
        @{$self->{HANDLERS}} ;
}


sub handler_descriptions {
    my $self = shift ;
    return map ref $_
        ? do {
            my $action = $self->machine->action_by_id( $$_ );
            die "Action $$_ for arc ",
                $self->name,
                " (id ",
                $self->id,
                ") not defined\n"
                unless $action;
            my $desc = $action->description;
            defined $desc ? $desc : $action->handlers;
        }
        : $_,
        @{$self->{HANDLERS}} ;
}


sub add_handler {
    my $self = shift ;
    push @{$self->{HANDLERS}}, @_ ;
}


sub handler_attributes {
    my $self = shift ;
    return map ref $_
        ? do {
            my $action = $self->machine->action_by_id( $$_ );
            die "Action $$_ for arc ",
                $self->name,
                " (id ",
                $self->id,
                ") not defined\n"
                unless $action;
            $action->attributes( @_ );
        }
        : (),
        @{$self->{HANDLERS}} ;
}


=item attribute

Like StateML::Object::attribute, but inherits from the event.

=cut

sub attribute {
    my $self = shift ;

    my $a = $self->SUPER::attribute( @_ ) ;
    if ( @_ < 3 && ! defined $a ) {
        my $e = $self->machine->object_by_id( $self->event_id ) ;
        $a = $e->attribute( @_ ) if defined $e ;
    }
    return $a ;
}


=item attributes

Like StateML::Object::attributes, but inherits from all handlers and then
the event.

=cut

sub attributes {
    my $self = shift ;

    my $e = $self->machine->object_by_id( $self->event_id ) ;
    my @ea ;
    @ea = $e->attributes( @_ ) if defined $e ;
    my @ha = $self->handler_attributes( @_ );

    my %a = ( @ha, @ea, $self->SUPER::attributes( @_ ) ) ;
    return %a ;
}

=back

=head1 LIMITATIONS

=head1 COPYRIGHT

    Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved

=head1 LICENSE

You may use this module under the terms of the BSD, Artistic, or GPL licenses,
any version.

=head1 AUTHOR

Barrie Slaymaker

=cut


1 ;