Arne Gödeke

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;
}

1 POD Error

The following errors were encountered while parsing the POD:

Around line 53:

Unknown directive: =old