XML::DTD::FAState - Perl module representing a state of a finite automaton

  use XML::DTD::FAState;

package XML::DTD::FAState;

use 5.008;
use strict;
use warnings;

our @ISA = qw();

our $VERSION = '0.09';


# Constructor
sub new {
  my $proto = shift; # Class name or object reference
  my $label = shift; # State label
  my $final = shift; # Final state flag

  my $cls = ref($proto) || $proto;
  my $obj = ref($proto) && $proto;

  my $self;
  if ($obj) {
    # Called as a copy constructor
    $self = { %$obj };
  } else {
    # Called as the main constructor
    $self = {
	     'label' => $label,  # State label
	     'final' => $final,  # Final state flag
	     'tdest' => {},      # Transition destinations
	     'tsymb' => {},      # Transition symbols
	     'bckrf' => {}       # Back references
	    };
  }
  bless $self, $cls;
  return $self;
}


# Determine whether object is of this type
sub isa {
  my $cls = shift;
  my $r = shift;

  if (defined($r) && ref($r) eq $cls) {
    return 1;
  } else {
    return 0;
  }
}


# Get state label
sub label {
  my $self = shift;

  return $self->{'label'};
}


# Get list of back references for state
sub backref {
  my $self = shift;

  return [keys %{$self->{'bckrf'}}];
}


# Get all outbound transitions as list of (destination,symbol) pairs
sub transitions {
  my $self = shift;

  # Initialise transition list
  my $trns = [];
  # Get list of all destination states
  my $dest = $self->deststates;
  my ($d, $s, $symb);
  # Work through list of destination states
  foreach $d (@$dest) {
    # Get list of transition symbols for transitions to current destination
    $symb = $self->outsymbols($d);
    # Work through list of transition symbols
    foreach $s (@$symb) {
      # Push (destination state,transition symbol) pair onto list
      push @$trns, [$d, $s];
    }
  }

  return $trns;
}


# Get array of all outbound transition symbols, or just those
# associated with a specified destination state
sub outsymbols {
  my $self = shift;
  my $dest = shift; # Destination state

  if (defined $dest) {
    return [keys %{$self->{'tdest'}->{$dest}}];
  } else {
    return [keys %{$self->{'tsymb'}}];
  }
}


# Get array of all destination states, or just those associated with a
# specified transition symbol
sub deststates {
  my $self = shift;
  my $symb = shift; # Transition symbol

  if (defined $symb) {
    return $self->{'tsymb'}->{$symb};
  } else {
    # Get list of all outbound transition symbols
    my $symb = $self->outsymbols;
    # Initialise hash used to ensure list only contains one occurrence
    # of each state
    my $uniq = {};
    # Initialise result list
    my $dest = [];
    my ($s, $d, $dlst);
    # Loop over all outbound transition symbols
    foreach $s (@$symb) {
      # Get list of destination states associated with current symbol
      $dlst = $self->deststates($s);
      # Loop over all destination states associated with current symbol
      foreach $d (@$dlst) {
	# Push the current state onto the list if not already encountered
	push @$dest, $d if (!$uniq->{$d});
	# Mark the current state as having been encountered
	$uniq->{$d} = 1;
      }
    }

    return $dest;
  }
}


# Add a transition to another state
sub settrans {
  my $self = shift;
  my $dest = shift; # Destination state
  my $symb = shift; # Transition symbol

  # Construct symbol hash for destination if not defined
  $self->{'tdest'}->{$dest} = {} if (!defined $self->{'tdest'}->{$dest});
  # Construct destination array for symbol if not defined
  $self->{'tsymb'}->{$symb} = [] if (!defined $self->{'tsymb'}->{$symb});
  # Push destination node onto list for corresponding symbol if same
  # (destination, symbol) transition not already present
  push @{$self->{'tsymb'}->{$symb}}, $dest
    if (!$self->{'tdest'}->{$dest}->{$symb});
  # Mark symbol in hash for corresponding destination
  $self->{'tdest'}->{$dest}->{$symb} = 1;
  # Mark backreference to transition source state
  $dest->{'bckrf'}->{$self} = 1;
}


# Remove a transition to another node
sub clrtrans {
  my $self = shift;
  my $dest = shift; # Destination state
  my $symb = shift; # Transition symbol

  # Remove symbol from hash for corresponding destination
  delete $self->{'tdest'}->{$dest}->{$symb};

  # Remove destination node from list for corresponding signal
  my ($n, $d);
  my $dlst = [];
  foreach $d (@{$self->{'tsymb'}->{$symb}}) {
    push @$dlst, $d if ($d != $dest);
  }
  $self->{'tsymb'}->{$symb} = $dlst;

  # Delete symbol hash for destination if empty
  delete $self->{'tdest'}->{$dest} if (scalar @$dlst == 0);
  # Delete destination array for symbol if empty
  delete $self->{'tsymb'}->{$symb}
    if (scalar @{$self->deststates($symb)} == 0);

  # Remove backreference to transition source state
  delete $dest->{'bckrf'}->{$self};
}


1;

__END__