#!/usr/bin/perl -w
package MyClass;
use Scalar::Util qw(blessed);
use Data::Dumper; 
{ package Data::Dumper; $Terse=1; $Indent=$Quotekeys=0;}
use strict;

# Look at first argument and return something that
# can be used as an object, either a shifted blessed ref
# a class name which isa MyClass or the string
# 'MyClass' (can be used 'MyClass'->func($c))
# Assume a MyClass object as the first param is the $self
# NOTE: should be called &_shift_self to shift @_ for parent;
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__) ) {
        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(@_);
}

our @args = ('mc');
sub do_something {
    my $self = &_shift_self;
    print "got @_\n";
    if(ref $self) {
        push @$self, @_;
    } else {
        my $class = $self;
        no strict 'refs';
        push @{"$class\::args"}, @_;
    }
}

1;

package MySubClass;
our @ISA = ('MyClass');
our @args = ('msc');

package main;


# function and class methods:

MyClass::dump_self(1);
# $self is <'MyClass'> got 1

#MySubClass::dump_self(2); -> subroutine &MySubClass::dump_self

MyClass->dump_self(3);
# $self is <'MyClass'> got 3

MySubClass->dump_self(4);
# $self is <'MySubClass'> got 4

print '@MyClass::args: ',join(',', @MyClass::args), "\n";
# @MyClass::args: mc,1,3
print '@MySubClass::args: ',join(',', @MySubClass::args), "\n\n";
# @MySubClass::args: msc,4

my $obj1 = MyClass->new();
my $obj2 = MySubClass->new();

# object methods:
$obj1->dump_self(5);
# $self is <bless( [1], 'MyClass' )> got 5

$obj1->dump_self(6);
# $self is <bless( [1,5], 'MyClass' )> got 6

$obj2->dump_self(7);
# $self is <bless( [1], 'MySubClass' )> got 7

# confused
MyClass::dump_self($obj1,'mistake, first arg');
# $self is <bless( [1,5,6], 'MyClass' )> got mistake, first arg
[download]