#!/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 got 5 $obj1->dump_self(6); # $self is got 6 $obj2->dump_self(7); # $self is got 7 # confused MyClass::dump_self($obj1,'mistake, first arg'); # $self is got mistake, first arg