File Coverage

blib/lib/Net/OAuth2/Scheme.pm

Criterion	Covered	Total	%
statement	12	31	38.7
branch	2	6	33.3
condition	0	3	0.0
subroutine	4	5	80.0
pod	1	1	100.0
total	19	46	41.3

use warnings;
use strict;

package Net::OAuth2::Scheme;
BEGIN {
  $Net::OAuth2::Scheme::VERSION = '0.020002_099';
}
# ABSTRACT: Token scheme definition framework for OAuth 2.0

our $Factory_Class = 'Net::OAuth2::Scheme::Factory';

# some inside_out object support
# ours are a little weird because our object data are
# the option values that live in closures
# so the only thing we put here are the methods
# which can vary wildly depending on context
#
my %methods_hash = (); # class -> methodname -> tag -> closure
my %next_tag = ();
my %free_tags = ();
our $Temp;

sub new {
    # I am still not convinced there will ever be subclasses;
    # makes much more sense to subclass or replace the factory;
    # but now that I've said that, someone will find an excuse,
    # so we'll just follow the paradigm anyway...
    my $class = shift;

    my $factory_class;
    if ($_[0] eq 'factory') {
        (undef, $factory_class) = splice(@_,0,2); # shift shift
        # Yes, this means (factory => classname) has to be first.
        # Cope.
    }
    else {
        $factory_class = $Factory_Class;
    }
    eval "require $factory_class" or die $@;
    my $factory = $factory_class->new(@_);

    # start the cascade of methods being implemented
    $factory->uses('root');

    # build the object, make sure the method definitions are there
    my $tag =
      pop @{$free_tags{$class} ||= []}
      || ($next_tag{$class} ||= 'a')++;
    for my $method ($factory->all_exports) {
        unless ($methods_hash{$class}{$method}) {
            # mom, dad, don't touch it, it's EVIL
            # but we stay completely strict... hahahahahaha
            eval <
package ${class};
my \%${method} = ();
sub ${method} {
    my \$self = shift;
    return \$${method}\{\$\$self}->(\@_);
}
\$@{[ __PACKAGE__ . '::Temp']} = \\\%${method};
END
            $methods_hash{$class}{$method} = $Temp;
            undef $Temp;
        }
        $methods_hash{$class}{$method}{$tag} = $factory->uses($method);
    }
    return bless \ $tag, $class;
}

sub DESTROY {
    my $self = shift;
    my $class = ref($self);
    for my $hash (values %{$methods_hash{$class}}) {
        delete $hash->{$$self};
    }
    push @{$free_tags{$class}}, $$self;
}

1;


__END__