view release on metacpan or  search on metacpan

lib/aliased/factory.pm  view on Meta::CPAN

package aliased::factory;
$VERSION = v0.0.1;

use warnings;
use strict;
use Carp;

=head1 NAME

aliased::factory - shorter versions of a class tree's constructors

=head1 SYNOPSIS

  use aliased::factory YAPI => 'Yahoo::Marketing';

  my $service = YAPI->KeywordResearchService->new(...);

  my $res = $service->getRelatedKeywords(
    relatedKeywordRequest =>
      YAPI->RelatedKeywordRequestType->new(...)
  );

=head1 About

This package is similar to L<aliased>, but performs on-demand loading
for packages below the shortened 'root package'.  For example, the above
code will automatically load the KeywordResearchService and
RelatedKeywordRequestType packages from the Yahoo::Marketing::
hierarchy.

To load a second-level package:

  use aliased::factory BAR => 'Foo::Bar';

  my $bort = BAR->Baz->Bort->new(...);

This would load the Foo::Bar::Baz and then Foo::Bar::Baz::Bort packages.
Each method call require()s the corresponding package and returns an
aliased::factory object, which has a new() method (see below.)

=cut

my $new_factory = sub {
  my $class = shift;
  bless \(shift) => $class;
};

my $err;

my $load = sub {
  my $package = shift;
  $package =~ s#::#/#g;
  $package .= '.pm';
  return 1 if(exists $INC{$package});

  local $@;
  my $ans = eval {require($package)};
  if($err = $@) {
    my $f = __FILE__;
    ($err = $@) =~ s/ at $f line \d+\.\n//;
    return;
  }

  return($ans);
};

=head1 Factory Method

=head2 new

Returns a new object of the class represented by the $factory object.

  my $instantiated = $factory->new(...);

The class being instantiated must have a new() method.

=cut

sub new {
  my $self = shift;
  return $$self->new(@_);
} ######################################################################

=head1 Meta Methods

The rest of this is functionality used to create the factory.

=head2 import

Installs a sub 'shortname' in your package containing an object pointed
at $package.

  aliased::factory->import(shortname => $package);

=cut

sub import {
  my $class = shift;
  @_ or return;

  my ($alias, $package, @also) = @_;
  croak("error") if(@also);

  my $caller = caller;