Net::PSYC::MMP::State

Index

---

Code Index:

• package Net::PSYC::MMP::State
  • outstate
  • state
  • assign
  • augment
  • diminish
• EOF

sub init { my $self = shift; # do state after encoding and stuff has been done, does not make a # difference really $self->{'connection'}->hook('send', $self, -10); $self->{'connection'}->hook('sent', $self); $self->{'connection'}->hook('receive', $self, 10); # do encoding-stuff _after_ state. this is essential if _encoding # ist stateful. return 1; }

sub send { my $self = shift; my ($vars, $data) = @_; # use Data::Dumper; # print STDERR Dumper(@_); # the current behaviour is to _set every var that # has not changed in 3 packages.. my $state = $self->{'state'}; my $state_temp = {}; my $newvars = {};

    # to bypass automatic state.. use ':'
    foreach (keys %$vars) {

	next if (/^:_/);
	if (/^=_/) {
	    $newvars->{$_} = $vars->{$_};
	    $state_temp->{substr($_, 1)} = [0, $vars->{$_}];
	    next;
	}
	if (/^\+_/) {
	    my $key = substr($_, 1);
	    $newvars->{$_} = $vars->{$_};
	    if (exists $state->{$key}) {
		unless (ref $state->{$key}->[1] eq 'ARRAY') {
		    $state_temp->{$key}->[1] = [ $state->{$key}->[1] ];
		}
		push(@{$state_temp->{$key}->[1]}, $vars->{$_});
	    } else {
		$state_temp->{$key}->[1] = [ $vars->{$_} ];
	    }
	    $state_temp->{$key}->[0] = 0; # we assume it to be consistent
	    next;
	}
	if (/^-_/) {
	    my $key = substr($_, 1);
	    $newvars->{$_} = $vars->{$_};
	    if (exists $state->{$key}) {
		if (ref $state->{$key}->[1] eq 'ARRAY') {
		    $state_temp->{$key}->[1] = grep { $_ eq $vars->{$_} } 
						    @{$state->{$key}->[1]}; 
		} else {
		    if ($state->{$key}->[1] eq $vars->{$_}) {
			$state_temp->{$key}->[0] = -1;	
		    }
		}
	    } else {
		# WOU?
	    }
	    $state_temp->{$key}->[0] = 0; # we assume it to be consistent
	    next;
	}

	if (!exists $state->{$_}) {
	    $state_temp->{$_} = [1, $vars->{$_}];
	    $newvars->{$_} = $vars->{$_};
	    next;
	}
	if ($state->{$_}->[1] ne $vars->{$_}) { # var has changed
	    if ($state->{$_}->[0] == 3) { # unset var
		$state_temp->{$_} = [1, $vars->{$_}];
		$newvars->{"=$_"} = '';
	    } elsif ($state->{$_}->[0] > 1) { # decrease counter
		$state_temp->{$_} = [ $state->{$_}->[0] - 1, $state->{$_}->[1]];
	    } elsif ($state->{$_}->[0] != 0) { # nothing set.. 
		$state_temp->{$_} = [1, $vars->{$_}];
	    }
	    $newvars->{$_} = $vars->{$_};
	    next;
	}
	if ($state->{$_}->[1] eq $vars->{$_}) {
	    if ($state->{$_}->[0] == 10 || $state->{$_}->[0] == 0) { 
		# is set anyway
		next;
	    } elsif ($state->{$_}->[0] == 2) {
		$newvars->{"=$_"} = $vars->{$_};
	    } elsif ($state->{$_}->[0] < 2) {
		$newvars->{$_} = $vars->{$_};
	    }
	    $state_temp->{$_} = [$state->{$_}->[0] + 1, $state->{$_}->[1]];
	}
    }

    foreach (keys %$state) {
	next if (exists $newvars->{$_} || exists $vars->{$_});

	if ($state->{$_}->[0] == 3) { # unset var
	    $newvars->{"=$_"} = '';
	    $state_temp->{$_} = [ 2, $state->{$_}->[1]];
	    next;
    	}
	$state_temp->{$_} = [ $state->{$_}->[0] - 1, $state->{$_}->[1]]
	    if ($state->{$_}->[0] != 0);
	$newvars->{$_} = '' if ($state->{$_}->[0] > 3);
    }

    $self->{'state_temp'} = $state_temp;
    %$vars = %$newvars; 
    return 1;
}

sub sent { my $self = shift; my ($vars, $data) = @_;

    foreach (keys %{$self->{'state_temp'}}) {
	if ($self->{'state_temp'}->{$_}->[0] == -1) {
	    delete $self->{'state'}->{$_};
	    next;
	}
	$self->{'state'}->{$_} = $self->{'state_temp'}->{$_};
    }
    return 1;
}

sub receive { my $self = shift; my ($vars, $data) = @_;

    foreach (keys %{$self->{'vars'}}) {
	unless (exists $vars->{$_}) {
#	    print "used assigned var $_ ($self->{'vars'}->{$_})!\n";
	    $vars->{$_} = $self->{'vars'}->{$_};
	}
    }

    foreach (keys %$vars) {
	if (/^_/) {
	    delete $vars->{$_} if ($vars->{$_} eq '');
	    next;
	}
	my $key = substr($_, 1);
	if (/^=_/) {
#	    print "assigned $key!\n";
	    if ($vars->{$_} eq '') {
		delete $self->{'vars'}->{$key};
		delete $vars->{$_};
		next;
	    }
	    $self->{'vars'}->{$key} = (ref $vars->{$_}) 
		? dclone($vars->{$_}) : $vars->{$_};

	    $vars->{$key} = delete $vars->{$_};
	    next;
	}
	if (/^\+_/) {
	    if (!exists $self->{'vars'}->{$key}) {
		$self->{'vars'}->{$key} = [ delete $vars->{$_} ];
		next;
	    }
	    if (ref $self->{'vars'}->{$key} eq 'ARRAY') {
		push(@{$self->{'vars'}->{$key}}, $vars->{$_});
	    } else {
		$self->{'vars'}->{$key} = [ $self->{'vars'}->{$key},
					  $vars->{$_} ];
	    }
	    delete $vars->{$_};
	    next;
	}
	if (/^-_/) {
	    if (!exists $self->{'vars'}->{$key}) {

	    } elsif (!ref $self->{'vars'}->{$key}) {
		delete $self->{'vars'}->{$key} 
		    if ($self->{'vars'}->{$key} eq $vars->{$_});
	    } elsif (ref $self->{'vars'}->{$key} eq 'ARRAY') {
		my $value = $vars->{$key};
		@{$self->{'vars'}->{$key}} = 
		    grep {$_ ne $value } @{$self->{'vars'}->{$key}};
	    }
	    delete $vars->{$_};
	    next;
	}
    }
    return 1;
}
=cut

package Net::PSYC::MMP::State;

use Storable qw(dclone);
use strict;

sub outstate {
    my $self = shift;
    my ($mod, $var, $val) = @_;

    return 1 if ($mod eq ':');
    
    if ($mod eq '=') {
	$self->{'state'}->{$var} = $val;
	return 1;
    } elsif ($mod eq '+') {
	Net::PSYC::_augment($self->{'state'}, $var, $val);
	return 1;
    } elsif ($mod eq '-') {
	return 1 if (Net::PSYC::_diminish($self->{'state'}, $var, $val));
    }
    return 0;
}

sub state {
    {}
}

sub assign {
    my $self = shift;
    my ($var, $val) = @_;

    unless ($val) {
	delete $self->{'vars'}->{$var};
	return 1;
    }
    $self->{'vars'}->{$var} = $val;
    $self->negotiate($val) if ($var eq '_using_modules');
}

sub augment {
    my $self = shift;
    my ($var, $val) = @_; 
    Net::PSYC::_augment($self->{'vars'}, @_);
    
    $self->negotiate($val) if ($var eq '_using_modules');
}

sub diminish {
    my $self = shift;
    Net::PSYC::_diminish($self->{'vars'}, @_);
}

1;