package Packet; my %patterns; # could add some in declaration sub addType { my $regex = shift; my $className = shift; $patterns{$className} = $regex; } sub removeType { my $className = shift; delete $patterns{$className}; } sub makeOnePacket { # get a packet my $packet = getAPacket(); return undef unless $packet; my $newObject; my ( $className, $regex ); while ( ( $className, $regex ) = each(%patterns) ) { my @fields; if ( @fields = ( $packet =~ $regex ) ) { $newObject = $className->new( $packet, @fields ); last; } } $newObject; } # These two must be defined by classes that want # to work with this system. sub newFromPacket { my $class = shift; my $packet = shift; my @fields = @_; # initialize as needed, return object. bless { packet => $packet, fields => \@fields }, $class; } sub process { my $self = shift; # now do whatever is necessary } package main; Packet::addType( qr/^(abc)(.*)/, 'SomeType' ); Packet::addType( qr/^(def)(.*)/, 'SomeOtherType' ); while ( my $newPacket = makeOnePacket() ) { $newPacket->process(); } #### package NewPacket; use Packet; # Could have inherited from Packet, but no # reason to. Luckily, this isn't Java or C++. sub newFromPacket { my $class = shift; my $packet = shift; my @fields = @_; # initialize as needed, return object. bless { packet => $packet, fields => \@fields }, $class; } sub process { my $self = shift; } # you could also use __PACKAGE__ here: Packet::addType( qr/^(something)(.*)/, 'NewPacket' ); Packet::addType( qr/^(somethingElse)(.*)/, 'NewPacket' ); # returns true