Give me something $self-ish

I had a little library which supported a number of interfaces: procedural, class-based and object-based. The _shift_self function called as my $self = &_shift_self looks at the caller's @_ and Does-What-I-Mean, possibly shifting the first arg or returning a class name.

A bigger example will follow.

package MyClass;
use Scalar::Util qw(blessed);

sub _shift_self {
    if(!defined $_[0]) {
        return __PACKAGE__;
    } elsif(blessed $_[0]
            && $_[0]->isa(__PACKAGE__) ) {
        return shift;
    } elsif ( $_[0] =~ /^[_a-zA-Z][\w:']*$/ # Legit package names
            && $_[0]->isa(__PACKAGE__) ) {
        # should it be UNIVERSAL::isa($_[0],__PACKAGE); ??
        return shift;
    } else {
        return __PACKAGE__;
    }
}

sub new {
    my $self = &_shift_self;
    my $class = ref $self || $self;
    return bless [1], $class;
}

sub dump_self {
    my $self = &_shift_self;

    print '$self is <',Dumper($self), '> ';
    $self->do_something(@_);
}
[download]

Back to Cool Uses for Perl