view release on metacpan or  search on metacpan

lib/Net/OAuth2/Scheme.pm  view on Meta::CPAN

use warnings;
use strict;

package Net::OAuth2::Scheme;
BEGIN {
  $Net::OAuth2::Scheme::VERSION = '0.03';
}
# 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 <<END ;
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__
=pod

=head1 NAME

Net::OAuth2::Scheme - Token scheme definition framework for OAuth 2.0

=head1 VERSION

version 0.03

=head1 SYNOPSIS

Exactly how the code would look depends on the respective server
frameworks in use and we're trying to be agnostic about that, but...

  our %access_options = (
    transport => 'bearer',
    format => 'bearer_handle',
    vtable => 'shared_cache',
    cache => Cache::Memcached->new(