p.s. yes, I know about the nested hash-of-hashes to traverse the global package names, but that's an implementation detail that is nearly invisible to standard Perl hackers.

my $class = 'My::Package::Class';
my $object = $class->new( ... );
[download]

Note that using the indirect object syntax (as you do) can cause problems.

Oooh yes. Even more scary:

use constant Class => 'My::Package::Class';
my $object = Class->new(...);
[download]

If you do that, I shall come over and slap you though. {grin}

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

---

update: And yes, I already slapped Ovid for Aliased in a previous discussion.

I said I wouldn't show it, but I suppose I will since you're sharing...

sub UNIVERSAL::new {
  my $class = caller() . "::" . shift;
  $class->new(@_);
}
[download]

It works by catching calls to new() on a package that doesn't have a new() defined. We're expecting this to mean the package doesn't really exist, and is instead the suffix of the full package name. We get the beginning of the package name from the package we called it in (caller()) and join it with the suffix (the first argument to new()), and use that as the package name. Example:

package A::B::C;
sub new { print "A::B::C new @_\n" }

package A::B;
C->new(10);

# C->new calls UNIVERSAL::new('C', 10)
# caller() returns 'A::B' (the package we were in)
# UNIVERSAL::new calls A::B::C->new(10)
[download]

I'll take my 20 lashes now.

(Double update: merlyn pointed out in a reply that my code is still an infinite loop, so I've readjusted it.) Update: to prevent infinite loops, I changed the code to:

sub UNIVERSAL::new {
  my $pkg = shift;
  my ($class, $file, $line) = caller;
  my $class = "${class}::$pkg";
  my $new = $class->can('new');
  return $class->$new(@_) if $new != \&UNIVERSAL::new;
  die qq{Can't locate object method "new" via packages $pkg or $class 
+at $file line $line.\n};
[download]

Gawrsh, now it's lookin' purty.

---

Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

Hmm ... I remember your objection/caution about using aliased when you had that contract, but I don't recall a thread about it. Other than the obvious problem of accidentally overwriting a namespace, why do you object to this? What am I missing here?

Cheers,
Ovid

New address of my CGI Course.

I was pretty sure that wouldn't even work, but it does. Yes, pretty scary. :-)
"What should it profit a man, if he should win a flame war, yet lose his cool?"

Otherwise: it's possible to have Class be a constant, in your package, with value "My::Package::Class". that ought to work too. Well, in my tests, it does. :)

package My::Package;
use constant Class => __PACKAGE__ . '::Class';

print ref Class->new;  # prints "My::Package::Class"

{
    package My::Package::Class;
    sub new {
        return bless {}, shift;
    }
}
[download]

OK, that works indeed. But (oh, I know it is cruel) I need to do that at runtime, within eval context.

So:

use aliased Foo::Bar::Object;
print ref Object->new();
[download]

works, so works this one:

use constant Object => 'Foo::Bar::Object';
print ref Object->new();
[download]

But eval'ing this stuff does not:

eval 'use aliased Gemini::Model::Object;';
print ref Object->new();
[download]

or:

eval qq[use constant Object => 'Foo::Bar::Object';];
print ref Object->new();
[download]

What's wrong with that? :)

It's too late at runtime, the rest of the script already got compiled. So "Object" is taken as a bareword string literal, and nothing can change that.

As a constant is nothing but a sub, you can use a similar sub that just returns the value of a scalar. You can always change the value for the scalar.

my $class = "Gemini::Model::Object";
sub Object () {
    return $class;
}
print ref Object->new();
[download]

You can always still change the value of that scalar.

But why the obfuscation? If you want to use a variable class, just say so. Perl lets you do that.

my $class = "Gemini::Model::Object";

print ref $class->new();
[download]

Looks fine to me.

Please also note that no one who responded to this used the indirect object notation. It's ambiguous and I highly recommend that you avoid it in the future. (new is not a keyword: try Class->new( ... ) instead.)

Or even better, use Class::->new and benefit from compile-time checks.

ihb

See perltoc if you don't know which perldoc to read!

Perl does not provide any facilities for this. There is no more relation between My::Package and My::Package::Class than there is between Foo and Bar (aside from the fact that builtins such as use and require, when asked to load My::Package::Class will look for Class.pm under subdirectories My/Package off the search path).

You could choose to live dangerously by messing with symbol tables:

use strict;
use warnings;

package My::Package::Class;

sub new {
  return bless +{};
}

sub foo {
  print "hello from " . __PACKAGE__ . "::foo\n";
}

package main;

*Class:: = \%My::Package::Class::;

my $object = Class->new();

$object->foo();
__END__
hello from My::Package::Class::foo
[download]

#!/usr/bin/perl -w

# ./test_class.pl

use strict;
use My::Package::Class;

my $c = Class->new("arg");
print ref($c)."\n";
[download]

# ./My/Package/Class.pm
package Class;
use strict;

sub new {
        my $class = shift;
        my $self = {
                        data => shift,
                };
        return(bless($self,$class));
}
1;
[download]

...which would befuddle the heck out of anyone used to conventions. Yuck!

water

Here's how it's used:

use Package::Relative;
my $object = (PKG . "Class")->new; # your example
my $object = (PKG . "..::Class")->new; # more interesting
[download]

Why the heck did you use overload instead of just exporting PKG():

   PKG("..::Class")->new;

-sam

I dunno... It's not like I'm going to use this code anyway...

I thought that __PACKAGE__ like semantics could be cool ;-)

-nuffin
zz zZ Z Z #!perl

This is quite sick. :-)

1. The relation between "Foo::Bar::MyClass" and the file "Foo/Bar/MyClass.pm" is only required by the pragma "use", i.e., when you say "use Foo::Bar::MyClass;", it will look for the file "Foo/Bar/MyClass.pm", it says nothing about the content of the file.
2. You can define any class in any file, i.e., in the file "Foo/Bar/MyClass.pm", you can define "package My::Other::FooClass;"
3. The line "use Foo::Bar::MyClass;" typically introduces some namespaces, it only depends on what namespaces are defined in the file Foo/Bar/MyClass.pm, not the file name itself. This, when combined with item 2 above, means, even if you "use Foo::Bar::MyClass;", you may not even have the namespace "Foo::Bar::MyClass", instead, you may only be able to do "my $obj = My::Other::FooClass->new();". Of course, this would be confusing, so it's a convention to match the content of a file with the file name, not a requirement.
4. There isn't a hiarchical relationship between "Foo::Bar::MyClass" and "MyClass" (that's why even in the file Foo/Bar/MyClass.pm, you still need to declare the full "Foo::Bar::MyClass", rather than simply "MyClass"), in fact, perl doesn't know the package "MyClass". What merlyn was refering to about symbol tables is that the implementation of symbol tables happen to split along "::", so the symbol table for "Foo::Bar::MyClass" can be found using "$::{'Foo::'}{'Bar::'}{'MyClass::'}":

   use strict;
   package Foo::Bar::MyClass;
   
   our $test = "test";
   
   package main;
   
   print keys %{$::{'Foo::'}{'Bar::'}{'MyClass::'}};
   
   __OUTPUT__
   test
   [download]