# package to group all constant, read-only vars like $DEBUG
# file is Constants.pm and can be placed in same dir as main script
# or in a './lib' dir, make sure to adjust 'use lib...' in any subscript it uses it
package Constants;
use strict;
use warnings;
# boilerplate
use Exporter;
our @ISA = qw/Exporter/;
# add here all the variables you want exported
our @EXPORT = qw/$CON1 $CON2 $DEBUG/;
our $CON1 = 'a constant';
our $CON2 = 'another constant';
our $DEBUG = 1;
1;
####
# usage from a so-called sub-script
use strict;
use warnings;
# this is where the Constants.pm file resides relative to the path of the subscript.
# good practices exist for where to place these files, this is just for demo
use lib 'lib';
use Constants;
print "Debug: $DEBUG\n";
##
##
# test.pl to demo the whole setup
# run as perl -I. test.pl
use strict;
use warnings;
do 'lib/subscript.pl';
die "failed $@" if $@;
##
##
package Sharedvariables;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
# store here all the variables you want to share with an initial value
'DEBUG' => 1,
};
bless $self, $class;
return $self;
}
# my ($class, $params) = $@;
# return bless {} => $class;
sub debug {
my $self = shift;
# optional boilerplate to keep track who called us and from where:
my $parent = (caller(1))[3]; if( ! defined($parent) ){ $parent = 'main' }
my $whoami = ( caller(0) )[3];
# optional parameter for setting the $DEBUG to a new value
# if this new-value is absent the we just return current value of $DEBUG
my $newvalue = shift;
if( defined $newvalue ){
warn "$whoami (via $parent) : modifying DEBUG from ".$self->{'DEBUG'}." to $newvalue";
$self->{'DEBUG'} = $newvalue
}
return $self->{'DEBUG'}
}
1;
##
##
# test it
use strict;
use warnings;
use lib 'lib';
use Sharedvariables;
my $SVars = Sharedvariables->new();
print "DEBUG: ".$SVars->debug()."\n";
$SVars->debug(42);
print "DEBUG: ".$SVars->debug()."\n";
##
##
package SharedvariablesM;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
# we store here all shared variables, but this is done automatic
store => {}
};
bless $self, $class;
return $self;
}
sub value {
my $self = shift;
my $name = shift;
# optional parameter for setting the $DEBUG to a new value
# if this new-value is absent the we just return current value of $DEBUG
my $newvalue = shift;
# optional boilerplate to keep track who called us and from where:
my $parent = (caller(1))[3]; if( ! defined($parent) ){ $parent = 'main' }
my $whoami = ( caller(0) )[3].'()';
my $itsnewname = ! exists $self->{'store'}->{$name};
if( defined $newvalue ){
if( $itsnewname ){
warn "$whoami (via $parent) : creating new variable '$name'..."
} else {
warn "$whoami (via $parent) : modifying '$name' from ".$self->{'store'}->{$name}." to $newvalue";
}
$self->{'store'}->{$name} = $newvalue
} elsif( $itsnewname ){
die "$whoami (via $parent) : you are creating a new shared variable named '$name' without a value unless you have the variable name wrong!"
}
return $self->{'store'}->{$name}
}
# clone ourselves and return new object
sub clone {
my $self = shift;
my $aclone = SharedvariablesM->new();
for my $name (keys %{$self->{'store'}}){
$aclone->value($name, $self->value($name));
}
return $aclone
}
sub toString {
my $self = shift;
my $ret = __PACKAGE__." here is what I store:\n";
for my $name (sort keys %{$self->{'store'}}){
$ret .= $name . '=>' . $self->{'store'}->{$name} . "\n"
}
return $ret;
}
1;
##
##
# and here is a test usage
use strict;
use warnings;
use lib 'lib';
use SharedvariablesM;
my $SVars = SharedvariablesM->new();
for (qw/var1 var2 var3/){
$SVars->value($_, $_);
}
print $SVars->toString();
my $clone = $SVars->clone();
print $clone->toString();