package BaseClass;
sub _classobj {
my $invocant = shift;
my $class = ref $invocant || $invocant;
no strict "refs";
return \%$class;
}
sub new {
my $invocant = shift;
my $class = ref $invocant || $invocant;
my $classData = $class->_classobj();
my $name = $classData->{Column_Header};
my $value = (@_)
? shift
: undef;
bless { name => "$name",
value => "$value",
cdata => \%classData,
}, $class;
}
sub get_column {
my $invocant = shift;
my $class = ref ($invocant) || $invocant;
my $cdata = $class->_classobj;
unless defined "$cdata" {
print "class data not found \n";
die;
}
my $column = $$cdata->{Input_column};
return $column;
}
1;
####
package ChildClass;
use base qw(BaseClass);
our %ChildClass = (
Blank_ok => 'no',
Column_header=> '^(cell|name)$',
Field_length => 20,
Input_column => 'Unknown',
Invalid_characters => '[^\W-]',
);
1;
####
#! /usr/bin/perl
use strict;
use warnings;
use diagnostics;
use Carp;
use ChildClass;
print "column: ", ChildClass->get_column;
####
> p $class
ChildClass
> x %ChildClass
empty array
> x %ChildClass::ChildClass
0 'Invalid_characters'
1 '[^\\W-]'
2 'Column_header'
3 '^(cell|name)$'
4 'Blank_ok'
5 'no'
6 'Input_column'
7 'Unknown'
8 'Field_length'
9 20