root/trunk/POE-Session-Magic/Magic.pm

package POE::Session::Magic;

*VERSION = \0.04;

use strict;
use warnings FATAL => "all";
use Scalar::Util qw( blessed );
use Attribute::Handlers;
use POE qw( Session Kernel );
use Symbol qw( delete_package );

my %Subroutine;
my %Inline;
my %Codemap;
my %Session;
my %Object;
my %Method;
my %Heap;
my $RUNNING = 0;

sub importsymbols {
    my $package = shift;

    no strict "refs";

    *{ $package . "::destroy" } = \&destroy;
    *{ $package . "::yield" } = \&yield;
    *{ $package . "::post" } = \&post;
    *{ $package . "::spawn" } = \&spawn;
    *{ $package . "::Heap" } = \&Heap;
    *{ $package . "::Kernel" } = \&Kernel;
    *{ $package . "::Heap" } = \&Heap;
}

sub inlinehandle {
    my ($referent, $package) = @_;

    return sub {
        if (defined $_[ARG0] and 
                ($_[ARG0] eq $package) or (ref $_[ARG0] eq $package)) {
            $referent->(@_[ARG1..ARG9]);
        }
        else {
            $referent->(@_[ARG0..ARG9]);
        }
    };
}

sub packagehandle {
    my ($referent, $package) = @_;

    return sub {
        if (defined $_[ARG0] and $_[ARG0] eq $package) {
            $referent->(@_);
        }
        else {
            $referent->($package, @_);
        }
    }
}

sub objecthandle {
    my ($referent, $package) = @_;

    return sub {
        if (defined $_[ARG0] and ref $_[ARG0] eq $package) {
            $referent->(@_);
        }
        elsif (defined $_[OBJECT] and ref $_[OBJECT] eq $package) {
            $referent->($_[OBJECT], @_);
        }
    }
}

sub UNIVERSAL::Inline :ATTR {
    my ($package, $symbol, $referent, $attr, $data) = @_;

    $Session{$package}{inline_states}{$referent} = 
        inlinehandle $referent, $package;
}

sub UNIVERSAL::Object :ATTR {
    my ($package, $symbol, $referent, $attr, $data) = @_;
    unless ($Object{$package}) {
        $Object{$package} = $package->new();
        $Method{$package} = [];
    }

    push @{ $Method{$package} }, $referent;

    $Session{$package}{object_states} ||= [ 
        $Object{$package} => $Method{$package}
    ];
}

sub UNIVERSAL::Package :ATTR {
    my ($package, $symbol, $referent, $attr, $data) = @_;
    
    $Subroutine{$package} ||= [];
    
    push @{ $Subroutine{$package} }, $referent;
    
    $Session{$package}{package_states} ||= [
        $package => $Subroutine{$package}
    ];
}

sub post { $poe_kernel->post(@_) }
sub yield { $poe_kernel->yield(@_) }
sub Kernel () { $poe_kernel }
sub Heap () { return $Heap{ $poe_kernel->get_active_session->ID } }

sub eventcall {
    my ($symbol, $package) = @_;

    return sub {
        printf "event(%d): %s called\n", $poe_kernel->get_active_session->ID,
            *{$symbol}{NAME};

        if (($_[0] eq $package) or (ref $_[0] eq $package)) {
            if (defined wantarray) {
                if (ref $_[0] eq $package) {
                    return $poe_kernel->call
                        ( ref($_[0]), *{$symbol}{NAME} => @_ );
                }
                else {
                    return $poe_kernel->call
                        ( $_[0], *{$symbol}{NAME} => @_ );
                }
            }
            else {
                if (ref $_[0] eq $package) {
                    print "event(): Sent post to ", ref($_[0]);

                    return $poe_kernel->post
                        ( ref($_[0]), *{$symbol}{NAME} => @_ );
                }
                else {
                    print "event(): Sent post to ", $_[0];
                    return $poe_kernel->post
                        ( $_[0], *{$symbol}{NAME} => @_ );
                }
            }
        }
        else {
            if (defined wantarray) {
                return $poe_kernel->call
                    ( $poe_kernel->get_active_session->ID,
                      *{$symbol}{NAME} => @_ );
            }
            else {
                $poe_kernel->yield ( *{$symbol}{NAME} => @_ );
            }
        }
    };
}

# TODO Make this delete any aliases that exist for this package
#      which will then destroy any sessions which only exist from aliases.
sub destroy {
    my $package = shift;
    print "Destroy called on $package";

    delete_package $package unless blessed $package;
    delete $Codemap{$package};

    if (my $session = $poe_kernel->alias_resolve($package)) {
        for my $alias ($poe_kernel->alias_list($session)) {
            $poe_kernel->alias_remove($alias);
        }
    }
}

# This is bad, I call _data_alias_add -- a POE internal method!
# Dont know any other way to do it...
sub spawn {
    my ($package, $alias) = @_;

    my %SessionArgs = %{ $Session{$package} };

    if (defined $alias) {
        no strict "refs";
        no warnings "redefine";

        %{ $alias . "::" } = %{ $package . "::" };
        createsession($alias);
        return $alias;
        for my $event (keys %{ $Codemap{$package} }) {
            $SessionArgs{inline_states}{$event} =
                inlinehandle $Codemap{$package}{$event}, $alias;
        }
    }

    my $session = POE::Session->create(%SessionArgs);

    my $session_id      = $session->ID;
    my $object          = \$session_id;
    $Heap{$session_id}  = $session->[0];

    if (defined $alias) {
        $Subroutine{$alias} = $Subroutine{$package};
        $Codemap{$alias}    = $Codemap{$package};
        $Object{$alias}     = $Object{$package};

        no strict "refs";
        no warnings "redefine";

        $Session{$alias} = $Session{$package};

        %{ $alias . "::" } = %{ $package . "::" };

        createsession($alias);
#        for my $symbol (keys %{ $package . "::" }) {
#            $Codemap{$alias}{*{$symbol}{NAME}} =
#                $Codemap{$package}{*{$symbol}{NAME}};
#        }

# I dont really know what the fuck I was thinking here...
#        for my $symbol (values %{ $package . "::" }) {
#            print $symbol;
#            *{$symbol} = $Codemap{$package}{*{$symbol}{CODE}};
#            *{$symbol} = eventcall *{$symbol}, $alias;
#            $Codemap{$alias}{*{$symbol}{NAME}} =
#                $Codemap{$package}{*{$symbol}{NAME}};
#        }
    
        $poe_kernel->_data_alias_add($session, $alias);
    }

    if (defined wantarray) {
        if ($alias) {
            return $alias;
        }
        else {
            return bless $object, $package;
        }
    }
}

sub createsession {    
    my $package = @_ ? shift : $_;

    my %Name;

    {
        no strict "refs";
        no warnings "uninitialized";

        for my $symbol (values %{ $package . "::" }) {
            $Name{*{$symbol}{CODE}} = *{$symbol}{NAME};

            no warnings "redefine";
            if (defined $Session{$package}{inline_states}{*{$symbol}{CODE}}) {
                $Codemap{$package}{*{$symbol}{NAME}} = *{$symbol}{CODE};
                *{$symbol} = eventcall $symbol, $package;
            }
        }
    }

    for my $ref (keys %{ $Session{$package}{inline_states} }) {
        $Session{$package}{inline_states}{$Name{$ref}} =
            delete $Session{$package}{inline_states}{$ref};
    }

    my $x = 0;
    for my $ref (@{ $Session{$package}{object_states} }) {
        if (ref $ref eq "ARRAY") {
            @{ $Session{$package}{object_states}[$x] } = map $Name{$_},
                @{ $Session{$package}{object_states}[$x] };
        }
        $x++;
    }

    $x = 0;
    for my $ref (@{ $Session{$package}{package_states} }) {
        if (ref $ref eq "ARRAY") {
            @{ $Session{$package}{package_states}[$x] } = map $Name{$_},
                @{ $Session{$package}{package_states}[$x] };
        }
        $x++;
    }
    
    my $start = 0;

    $start++ if defined $Session{$package}{inline_states}{_start};

    for my $package (@{$Session{$package}{package_states}}) {
        if (ref $package eq "ARRAY") {
            $start++ if grep m/_start/, @$package;
        }
    }

    for my $object (@{$Session{$package}{object_states}}) {
        if (ref $object eq "ARRAY") {
            $start++ if grep m/_start/, @$object;
        }
    }

    unless ($start) {
        $Session{$package}{inline_states} ||= {};
        $Session{$package}{inline_states}{_start} = sub {
            $_[KERNEL]->alias_set($package);
        };
    }

    spawn $package;
}

create POE::Session inline_states => {
    _start => sub {
        $_[KERNEL]->alias_set("MS_META");
    },

    create => sub {
        createsession $_[ARG0];
    },
};

sub import {
    my $caller = caller;

    eval "package $caller; POE::Session->import;";
    eval "package $caller; POE::Kernel->import;";

    importsymbols $caller;

    $poe_kernel->post(MS_META => create => $caller);
}

INIT {
    $RUNNING++;

    POE::Kernel->run;
};

=head1 NAME

  POE::Session::Magic - A very magical way to code in POE using attributes.

=head1 SYNOPSIS

 use POE::Session::Magic;

 sub _start : Inline {
     yield foo => "POE is running";
 }
 
 sub foo : Inline {
     print shift;
 }
 
 sub _stop : Inline {
     print "POE has been shut down...";
 }

=head1 RATIONALE

I've spent a fair amount of time being a POE Advocate, telling people to use
it for every task I could imagine would be appropriate.  I've heard quite
a few times that its API is rather confusing in relation to the logic and
mechanics of a POE application.  In fact, too many times.  Personally I really
enjoy POE's API, but apparently its use of various unpopular Perl features is
quite a bit for a new POE user to deal with.  This module is an attempt to
address this issue.  The intent, is to make POE coding as straight forward as
possible without confusing the user by doing many things they are unfamiliar
with.  The goal is to make POE programs written almost exactly like average
perl programs, without removing any of the features of POE.  Everything will
be accessed in normal methods, and accessors will be provided for less commonly
used aspects of the POE API.

=head1 GOALS

Subroutines automatically become events by having attributes.

Packages automatically become sessions by using module.

Sessions automatically create packages from session aliases.

Arguements are just like normal arguements.

Heap is standardized, easy to access, per session, and doesn't need passed
around.

Speed isn't hurt too bad, although it will be inherently.

=head1 INTRODUCTION

=over 4

=item Using POE in a different way

POE has quite a history.

=back

=head1 AUTHOR

Scott S. McCoy (tag@cpan.org)

=head1 THANKS

Rocco as always, he provided some very useful insight while making design
and semantic decisions for this module.

=head1 SEE ALSO

L<POE> L<POE::Session>

=cut

1;