package Net::PSYC::State;
use strict;
our $VERSION = '0.1';
use strict;
# module implementing psyc-state-maintainance for objects...
#
# the state of mmp-vars is maintained by the connection
# object!
#
# right know I am not quite happy to have 2 objects for state. the wrapper and
sub new {
my $class = shift;
my $unl = shift;
my $self = {
# 'co' => {},
'o' => {},
# this is temporary out-state. just to keep keep in mind variables which
# have been set manually by the api. these variables are really assigned
# when a tcp packet is send.
'to' => {},
# ci is the in
'ci' => {},
'i' => {},
};
return bless $self, $class;
}
# sendmsg ( target, mc, data, vars[, source || mmp-vars ] )
sub sendmsg {
my $self = shift;
my $s = $self->{'o'};
my $vars = $_[3];
if (exists $s->{$_[0]}) {
foreach (keys %{$s->{$_[0]}}) {
if (!exists $vars->{$_}) {
$vars->{$_} = '';
} elsif ($vars->{$_} eq $s->{$_}) {
delete $vars->{$_};
}
}
}
}
# msg ( source, mc, data, vars )
sub msg {
my $self = shift;
my ($source, $vars) = ($_[0], $_[3]);
my $s;
if (exists $vars->{'_context'}) {
return unless (exists $self->{'ci'}->{$vars->{'_context'}});
$s = $self->{'ci'}->{$vars->{'_context'}};
} else {
return unless (exists $self->{'i'}->{$source});
$s = $self->{'i'}->{$source};
}
foreach (keys %$s) {
$vars->{$_} = $s->{$_} unless (exists $vars->{$_});
}
}
# ( source, key, value )
sub diminish {
my $self = shift;
my ($source, $key, $value, $iscontext) = @_;
my $s = ($iscontext) ? $self->{'ci'} : $self->{'i'};
return unless (exists $s->{$source});
Net::PSYC::_diminish($s->{$source}, $key, $value);
}
sub augment {
my $self = shift;
my ($source, $key, $value, $iscontext) = @_;
my $s = ($iscontext) ? $self->{'ci'} : $self->{'i'};
$s->{$source} = {} unless (exists $s->{$source});
Net::PSYC::_augment($s->{$source}, $key, $value);
}
sub assign {
my $self = shift;
my ($source, $key, $value, $iscontext) = @_;
my $s = ($iscontext) ? $self->{'ci'} : $self->{'i'};
$s->{$source} = {} unless (exists $s->{$source});
$s->{$source}->{$key} = $value;
}
# new API ( we will see how good it works )
sub outstate {
my $self = shift;
my ($mod, $key, $value, $t, $iscontext) = @_;
$self->{'o'}->{$t} = {} unless (exists $self->{'o'}->{$t});
my $o = $self->{'o'}->{$t};
if ($mod eq ':') {
return 0 if (exists $o->{$key} && $o->{$key} eq $value);
return 1;
}
# to implement automated state here we would need to
# return 0 if the var is not to be send and fill everything else
# into $to. TODO
if ($mod eq '=') {
$o->{$key} = $value;
} elsif ($mod eq '+') {
Net::PSYC::_augment($o, $key, $value);
} elsif ($mod eq '-') {
Net::PSYC::_diminish($o, $key, $value);
}
return 1; # 1 means: render it..
}
# i dont like that name. returns vars currently set.
#
sub state {
my $self = shift;
my ($target, $iscontext) = @_;
return (exists $self->{'to'}->{$target} ? delete $self->{'to'}->{$target}
: {});
}
1;