Re: Re: Use constant vs. hashes

This is one I developed seperately with more stuff in it, also allowing constant hashes and arrays (much like tuples in python as I understand them). It also uses a different and IMHO cleaner syntax for creating the constants:
Const my $foo => 42;

Here's the sample program:

#!/usr/bin/perl -w
use strict;

use Const qw/Const ConstHash ConstArray/;

Const my $FOO => 42;
# tie my $FOO, 'Const', 42;

print "$FOO\n";         # prints "42"
$FOO = 43;              # croaks for attempted change
$FOO++;                 # same


ConstHash my %BOO => { foo => 'blah', moo => 41, 2 => 'no' };
# tie my %BOO, 'ConstHash', { foo => 'blah', moo => 41, 2 => 'no' };

print "$BOO{foo} $BOO{2}\n";  # prints "blah no"
$BOO{moo}++;            # croaks for attempted change
%BOO = ();              # same
print "$BOO{Foo}\n";    # croaks for non-existant element


ConstArray my @MOO => [ qw/foo 2 five seven/ ];
# tie my @MOO, 'ConstArray', [ qw/foo 2 five seven ];

print "$MOO[0] $MOO[3]\n";  # prints "foo seven"
$MOO[1]++;              # croaks for attemped change
$MOO[5] = 2;            # same
splice(@MOO,1,1,4);     # same again
print "$MOO[10]\n";     # croaks for non-existant element
[download]

And the implementation in Const.pm (click Read More)

use 5.006;
use strict;
use Exporter ();
use Carp ();

#######################################################
                   package Const;
# allows export of function to faciliate constant usage
#######################################################
our @EXPORT_OK = qw/Const ConstHash ConstArray/;
our @ISA = qw/Exporter/;

sub Const ($$) { tie $_[0], 'ConstScalar', $_[1] }
sub ConstHash (\%$) { tie %{ $_[0] }, 'ConstHash', $_[1]; }
sub ConstArray (\@$) { tie @{ $_[0] }, 'ConstArray', $_[1]; }

#############################################
            package ConstScalar;
# scalars set on tying, altering causes croak
#############################################

use Tie::Scalar ();
our @ISA = qw/Tie::StdScalar/;

sub STORE { Carp::croak "fatal: Const cannot be altered" }


###########################################
           package ConstHash;
# hashes which are fully set on tying,
#  altering, or accessing unset keys croaks
###########################################

use Tie::Hash ();
our @ISA = qw/Tie::StdHash/;

sub TIEHASH { bless { %{$_[1]} }, $_[0] }       # shallow clone
sub STORE { Carp::croak "fatal: ConstHash cannot be altered" }
sub DELETE { Carp::croak "fatal: ConstHash cannot be altered" }
sub CLEAR { Carp::croak "fatal: ConstHash cannot be altered" }
sub FETCH {
        if (exists $_[0]->{$_[1]}) { return $_[0]->{$_[1]} }
        else { Carp::croak "fatal: key '$_[1]' doesn't exist in this C
+onstHash"
}
}


#############################################
           package ConstArray;
# Arrays which are fully set on tying,
#  altering or accessing unset indexes croaks
#############################################

use Tie::Array ();
our @ISA = qw/Tie::StdArray/;

sub TIEARRAY { bless [ @{$_[1]} ], $_[0] }      # shallow clone

BEGIN{ #lazy shortcut
        for (qw/STORESIZE STORE CLEAR POP PUSH SHIFT UNSHIFT DELETE SP
+LICE/) {
                eval "sub $_ { Carp::croak 'fatal: ConstArray cannot b
+e altered'
 }";
        }
}

sub FETCH {
        if ($_[1] > $#{$_[0]}) { Carp::croak "fatal: array element $_[
+1] does no
t exist in this ConstArray" }
        $_[0]->[$_[1]];
}

#############################################
42;
[download]

Comment on Re: Re: Use constant vs. hashes Select or Download Code

Replies are listed 'Best First'.
Re: Use constant vs. hashes by legLess (Hermit) on Jul 03, 2001 at 21:38 UTC
Thanks to everyone - some great ideas here. And, as I'd hoped, a couple that I hadn't thought of :) -- man with no legs, inc.	[reply]