POE::Component::Tie - Perl extension that sends POE events on tie

POE-Component-Tie documentation Contained in the POE-Component-Tie distribution.

Index

Code Index:

NAME

Top

POE::Component::Tie - Perl extension that sends POE events on tie method invocations.

SYNOPSIS

Top

  use POE;
  use POE::Component::Tie;

  my $session = POE::Session->create(
    inline_states => {
      _start => sub {},
      STORE  => \&handler,
      [...] # place other handlers here you want for tie method events
   }
  );

  my $scalar;
  tie($scalar, "POE::Component::Tie", $session, $poe_kernel);
  $scalar = "Test!";

  $poe_kernel->run();

  sub handler {
    print "Got STORE event";
  }

DESCRIPTION

Top

The POE::Component::Tie package allows you to tie a scalar, array, or hash, and then have the tie methods sent as events to a POE session. Since there is no way to know the name of the variable being tied, that information is not passed back to the POE event. You will need to make a POE session and handlers for each variable you want to tie with this package. It is also worth mentioning due to this, some events that may be found in both ARRAY and HASH may pass something different back. See the documentation to know what exactly to expect back.

METHODS

Top

List of each tie method that send events.

TIESCALAR

Sends the event TIESCALAR with no arguments.

TIEARRAY

Sends the event TIEARRAY with no arguments.

TIEHASH

Sends the event TIEHASH with no arguments.

CLEAR

Sends the event CLEAR, and also sends what was contained in the variable as ARG0 in a reference.

EXAMPLES
  sub handler {
    my $clear_ref = $_[ARG0]
    my %hash  = %{$clear_ref}; # if was a hash
    my @array = @{$clear_ref}; # if was an array
    ...
  }

DELETE

Sends the event DELETE, and depending on the type of variable being tied, some arguments.

HASH

From the POE event, ARG0 will contain a hash reference with the keys key, and value. The key key will be the hash key, and value will be the value being deleted.

ARRAY

For an array, it will be the same as a hash, but instead of the hash key key, it will be index.

EXAMPLE
  sub handler {
    my $deleted = $_[ARG0];
    print "The index: $deleted->{index} was deleted, the value was $deleted->{value}\n"; # array
    print "The key: $deleted->{key} was deleted, the value was $deleted->{value}\n";     # hash
    ...
  }

DESTROY

Not implemented.

EXISTS

Sends the event EXISTS, and depending on the type of variable being tied, some arguments.

HASH

From the POE event, ARG0 will contain a hash reference with the keys key, and exists. The key key is the key of the hash, while exists is the return value of exists on that key.

ARRAY

For an array, it will be the same as a hash, but instead of the hash key key, it will be index.

EXAMPLE
  sub handler {
    my $exists = $_[ARG0];
    print "$exists->{key} return value from exists is $exists->{exists}\n";   # hash
    print "$exists->{index} return value from exists is $exists->{exists}\n"; # array
    ...
  }

EXTEND

Sends the event EXTEND, and will send as ARG0, the size extended.

EXAMPLE
  sub handler {
    my $size = $_[ARG0];
    ...
  }

FETCH

Sends the event FETCH, and depending on the type of variable being tied, some arguments.

SCALAR

From the POE event, ARG0 will contain what is being fetched.

HASH

From the POE event, ARG0 will contain a hash reference with the keys key and value, which will contain the hash key and the value of that key.

ARRAY

From the POE event, ARG0 will contain a hash reference with the keys index and value, which will contain the index position and value of that position.

EXAMPLES
  # Scalar
  sub handler {
    my $fetched = $_[ARG0];
    print "got $fetched\n";
  }

  # Array or Hash
  sub handler {
    my $fetched = $_[ARG0];
    print "Fetched: $fetched->{value}\n";
    ...
  }

FETCHSIZE

Sends the event FETCHSIZE, and will send as ARG0, the size of the array.

EXAMPLE
  sub handler {
    my $size = $_[ARG0];
    ...
  }

FIRSTKEY

Sends the event FIRSTKEY, and will send as ARG0, the first key.

EXAMPLE
  sub handler {
    my $key = $_[ARG0];
    ...
  }

NEXTKEY

Sends the event NEXTKEY, and will send as ARG0, the next key.

EXAMPLE
  sub handler {
    my $key = $_[ARG0];
    ...
  }

POP

Sends the event POP, and will send as ARG0, what was returned from pop.

EXAMPLE
  sub handler {
    my $popped = $_[ARG0];
    ...
  }

PUSH

Sends the event PUSH, ARG0 will contain a hash reference with the keys list, and size. The key list will be an array of what was pushed on, and return will be the value returned from push.

EXAMPLE
  sub handler {
    my $pushed = $_[ARG0];
    print "Caught PUSH: List pushed: '@{$pushed->{list}}', return value: $pushed->{return}\n";
    ...
  }

SCALAR

Not implimented yet. New in Perl 5.8.3

SHIFT

Sends the event SHIFT, and will send as ARG0, what was returned from shift.

EXAMPLE
  sub handler {
    my $shifted = $_[ARG0];
    ...
  }

SPLICE

Sends the event SPLICE, nothing returned, yet. TODO

EXAMPLE
  sub handler {
    print "Got splice\n";
    ...
  }

STORE

Sends the event STORE, and depending on the type of variable being tied, some arguments.

SCALAR

From the POE event, ARG0 will what the value of the scalar used to be, while ARG1 will be the new value.

HASH

From the POE event, ARG0 will contain will contain a hash reference with the keys key, and value, which will contain the value of what the value used to be. While ARG1 will contain a hash reference with the same structure, except its key value will contain the new value of the hash.

ARRAY

For an array, it will be the same as a hash, but instead of the hash key key, it will be index.

EXAMPLES
  # Scalar
  sub handler {
    my ($orig, $new) = @_[ARG0, ARG1];
    ...
  }

  # Array or Hash
  sub handler {
    my ($orig, $new) = @_[ARG0, ARG1];
    print "$orig->{value} now $new->{value}\n";
    ...
  }

STORESIZE

Sends the event FIRSTKEY the size stored as ARG0.

EXAMPLE
  sub handler {
    my $size = $_[ARG0];
    print "Got STORESIZE of $size\n";
    ...
  }

UNSHIFT

Sends the event UNSHIFT, ARG0 will contain a hash reference with the keys list, and size. The key list will be an array of what was unshifted on, and return will be the value returned from unshift.

EXAMPLE
  sub handler {
    my $unshifted = $_[ARG0];
    print "Caught UNSHIFT: List unshifted: '@{$unshifted->{list}}', return value: $unshifted->{return}\n";
    ...
  }

UNTIE

Sends the event UNTIE with no arguments.

EXAMPLE
  sub handler {
    print "Got UNTIE\n";
  }

EXPORT

Top

None by default.

BUGS

Top

SPLICE does not pass any arguments to the SPLICE event, like it should.

If DESTROY method sends event to POE, the following warning is issued: '(in cleanup) Can't call method "post" on an undefined value...'. It would be nice to be able to send an event on DESTROY.

TODO

Top

Add TIEHANDLE and it's methods.
Add SCALAR for hashes (5.8.3 and higher).
SPLICE needs to pass arguments.
More tests
Documentation, Documentation, Documentation!

VERSION

Top

This is an alpha version release. Please use at your own risk. Bug reports, patches, or comments, please send an email to the address below.

SEE ALSO

Top

POE, perltie

AUTHOR

Top

Larry Shatzer, Jr., <larrysh@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2004 by Larry Shatzer, Jr.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

POE-Component-Tie documentation Contained in the POE-Component-Tie distribution. 
package POE::Component::Tie;

use strict;
use warnings;
use warnings::register;
use Carp;
use UNIVERSAL qw(isa);

our $VERSION = '0.01';


sub TIESCALAR {
  my $self    = shift;
  my $session = shift;
  my $kernel  = shift;
  my $data    = shift || "";
  unless((isa $session, "ARRAY") && (isa $session, "POE::Session")) {
    croak('->TIESCALAR: Not POE::Session Object');
  }
  unless((isa $kernel, "ARRAY") && (isa $kernel, "POE::Kernel")) {
    croak('->TIESCALAR: Not POE::Kernel Object');
  }
  my $internal = {
    SESSION => $session,
    KERNEL  => $kernel,
    DATA    => $data,
    TYPE    => "SCALAR",
  };
  $kernel->post($session, 'TIESCALAR');
  return bless $internal, $self;
}


sub TIEARRAY {
  my $self = shift;
  my $session = shift;
  my $kernel  = shift;
  my @data = @_ || [];
  unless((isa $session, "ARRAY") && (isa $session, "POE::Session")) {
    croak('->TIESCALAR: Not POE::Session Object');
  }
  unless((isa $kernel, "ARRAY") && (isa $kernel, "POE::Kernel")) {
    croak('->TIESCALAR: Not POE::Kernel Object');
  }
  my $internal = {
    SESSION => $session,
    KERNEL  => $kernel,
    DATA    => @data,
    TYPE    => "ARRAY",
  };
  $kernel->post($session, 'TIEARRAY');
  return bless $internal, $self;
}


sub TIEHASH {
  my $self = shift;
  my $session = shift;
  my $kernel  = shift;
  my $data_ref = shift || {};
  unless((isa $session, "ARRAY") && (isa $session, "POE::Session")) {
    croak('->TIESCALAR: Not POE::Session Object');
  }
  unless((isa $kernel, "ARRAY") && (isa $kernel, "POE::Kernel")) {
    croak('->TIESCALAR: Not POE::Kernel Object');
  }
  my $internal = {
    SESSION => $session,
    KERNEL  => $kernel,
    DATA    => $data_ref,
    TYPE    => "HASH",
  };
  $kernel->post($session, 'TIEHASH');
  return bless $internal, $self;
}


sub CLEAR {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  $self->{KERNEL}->post($self->{SESSION}, 'CLEAR', $self->{DATA});
  if ($self->{TYPE} eq "ARRAY") {
    $self->{KERNEL}->post($self->{SESSION}, 'CLEAR', $self->{DATA});
    return $self->{DATA} = [];
  }
  elsif ($self->{TYPE} eq "HASH") {
    $self->{KERNEL}->post($self->{SESSION}, 'CLEAR', %{$self->{DATA}});
    return %{$self->{DATA}} = ();
  }
}


sub DELETE {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  if ($self->{TYPE} eq "ARRAY") {
    my $index = shift;
    $self->{KERNEL}->post($self->{SESSION}, 'DELETE', {index => $index, value => $self->{DATA}->[$index]});
    return $self->STORE($index, undef);
  }
  elsif ($self->{TYPE} eq "HASH") {
    my $key = shift;
    $self->{KERNEL}->post($self->{SESSION}, 'DELETE', {key => $key, value => $self->{DATA}->{$key}});
    return delete $self->{DATA}->{$key};
  }
}


sub DESTROY {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  #(in cleanup) Can't call method "post" on an undefined value
  #$self->{KERNEL}->post($self->{SESSION}, 'DESTROY');
}


sub EXISTS {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  if ($self->{TYPE} eq "ARRAY") {
    my $index = shift;
    if (!defined $self->{DATA}->[$index]) {
      $self->{KERNEL}->post($self->{SESSION}, 'EXISTS', {index => $index, exists => 0});
      return 0;
    }
    else {
      $self->{KERNEL}->post($self->{SESSION}, 'EXISTS', {index => $index, exists => 1});
      return 1;
    }
  }
  elsif ($self->{TYPE} eq "HASH") {
    my $key = shift;
    my $exists = exists $self->{DATA}->{$key};
    $self->{KERNEL}->post($self->{SESSION}, 'EXISTS', {key => $key, exists => $exists});
    return $exists;
  }
}


sub EXTEND {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $count = shift;
  $self->{KERNEL}->post($self->{SESSION}, 'EXTEND', $count);
  $self->STORESIZE($count);
}


sub FETCH {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  if ($self->{TYPE} eq "SCALAR") {
    $self->{KERNEL}->post($self->{SESSION}, 'FETCH', $self->{DATA});
    return $self->{DATA};
  }
  elsif ($self->{TYPE} eq "ARRAY") {
    my $index = shift;
     $self->{KERNEL}->post($self->{SESSION}, 'FETCH', {index => $index, value => $self->{DATA}->[$index]});
    return $self->{DATA}->[$index];
  }
  elsif ($self->{TYPE} eq "HASH") {
    my $key = shift;
    $self->{KERNEL}->post($self->{SESSION}, 'FETCH', {key => $key, value => $self->{DATA}->{$key}});
    return $self->{DATA}->{$key};
  }
}


sub FETCHSIZE {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $size = scalar(@{$self->{DATA}});
  $self->{KERNEL}->post($self->{SESSION}, 'FETCHSIZE', $size);
  return $size;
}


sub FIRSTKEY {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $a = keys %{$self->{DATA}}; # reset the each operator.
  my $each = each %{$self->{DATA}};
  $self->{KERNEL}->post($self->{SESSION}, 'FIRSTKEY', $each);
  return $each;
}


sub NEXTKEY {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $each = each %{$self->{DATA}};
  $self->{KERNEL}->post($self->{SESSION}, 'NEXTKEY', $each);
  return $each;
}


sub POP {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $pop = pop @{$self->{DATA}};
  $self->{KERNEL}->post($self->{SESSION}, 'POP', $pop);
  return $pop;
}


sub PUSH {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my @list = @_;
  push(@{$self->{DATA}}, @list);
  my $return = $self->FETCHSIZE();
  $self->{KERNEL}->post($self->{SESSION}, 'PUSH', {list => \@list, return => $return});
  return $return;
}


# TODO


sub SHIFT {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $shift = shift @{$self->{DATA}};
  $self->{KERNEL}->post($self->{SESSION}, 'SHIFT', $shift);
  return $shift;
}


# TODO need to figure how to send this POE event
sub SPLICE {
  my $self    = shift;
  confess "I am not a class method" unless ref $self;
  $self->{KERNEL}->post($self->{SESSION}, 'SPLICE');
  my $size   = $self->FETCHSIZE;
  my $offset = @_ ? shift : 0;
  $offset += $size if $offset < 0;
  my $length = @_ ? shift : $size-$offset;
  return splice(@{$self->{DATA}},$offset,$length,@_);
}


sub STORE {
  my $self  = shift;
  confess "I am not a class method" unless ref $self;
  if ($self->{TYPE} eq "SCALAR") {
   my $value = shift;
    $self->{KERNEL}->post($self->{SESSION}, 'STORE', $self->{DATA}, $value);
    return $self->{DATA} = $value;
  }
  elsif ($self->{TYPE} eq "ARRAY") {
    my $index = shift;
    my $value = shift;
    $self->{KERNEL}->post($self->{SESSION}, 'STORE',
      {index => $index, value => $self->{DATA}->[$index]},
      {index => $index, value => $value}
    );
    return $self->{DATA}->[$index] = $value;
  }
  elsif ($self->{TYPE} eq "HASH") {
    my $key   = shift;
    my $value = shift;
    $self->{KERNEL}->post($self->{SESSION}, 'STORE',
      {key => $key, value => $self->{DATA}->{$key}},
      {key => $key, value => $value}
    );
    return $self->{DATA}->{$key} = $value;
  }
}


sub STORESIZE {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my $count = shift;
  $self->{KERNEL}->post($self->{SESSION}, 'STORESIZE', $count);
  if ($count > $self->FETCHSIZE()) {
    foreach ($count - $self->FETCHSIZE() .. $count - 1) {
      $self->STORE($_, undef);
    }
  }
  elsif ($count < $self->FETCHSIZE()) {
    foreach (0 .. $self->FETCHSIZE() - $count - 2) {
      $self->POP();
    }
  }
}


sub UNSHIFT {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  my @list = @_;
  unshift(@{$self->{DATA}}, @list);
  my $size = $self->FETCHSIZE();
  $self->{KERNEL}->post($self->{SESSION}, 'UNSHIFT', {list => \@list, return => $size});
  return $size;
}


sub UNTIE {
  my $self = shift;
  confess "I am not a class method" unless ref $self;
  $self->{KERNEL}->post($self->{SESSION}, 'UNTIE');
  return $self->{DATA}    if ($self->{TYPE} eq "SCALAR");
  return @{$self->{DATA}} if ($self->{TYPE} eq "ARRAY");
  return %{$self->{DATA}} if ($self->{TYPE} eq "HASH");
}


1;