# 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();