Re: Constants (was Re: [Nms-cgi-devel] Various Stuff);

[Jonathan S. <gel...@ge...>]

On Tue, 29 Jan 2002, Jonathan Stowe wrote:
>
> I'm having a little difficulty with the tied scalar part - that would be
> the best bet though if we could hide the implementation details ...
>


I was having a little moment of brainlessness with this:

#!/usr/bin/perl -w

use strict;

BEGIN
{
  @main::config_vars = qw($foo);
};


use vars @main::config_vars;

$foo = 'zub';


foreach my $var (@main::config_vars)
{

  no strict 'refs';

  $main::tmp = eval "$var";

  $var =~ s/\$//g;

  my $obj = tie ${$var}, 'ReadOnly';

  ${$var} = $main::tmp;

  use strict 'refs';

  $obj->readonly(1);


}

$foo = 'gab';


BEGIN
{

   package ReadOnly;

   sub TIESCALAR
   {

     my ( $class ) = @_;


     my $gab = {readonly => 0, value => ''};

     return( bless $gab, $class);
   }


   sub STORE
   {
      my ( $self, $value  ) = @_;


      if ( $self->readonly )
      {
        die 'No you dont matey';
      }
      else
      {
        $self->{value} = $value;
      }
   }

   sub FETCH
   {
      my ( $self) = @_;


      return $self->{value};
   }

   sub readonly
   {
      my ( $self, $readonly ) = @_;

      if ( defined $readonly )
      {
         $self->{readonly} = $readonly;
      }

      return $self->{readonly};
   }

}


Equally shocking as I am sure you will agree.

The XS version is a lot nicer -  shame we can't use that:

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"


MODULE = ReadOnly               PACKAGE = ReadOnly


void
readonly(sv)
SV *sv
        PPCODE:
           SvREADONLY_on(sv);


:)


I'm sure there is already a module that does this on CPAN, but I've
reinvented it anyhow (by the time I'd done the above and got a harness
to test it I'd written a module) ... if anyone is interested it can be
found in its entirety at:

   <http://petunia.gellyfish.com/modules/ReadOnly-1.2.tar.gz>

Or will be when I get to the office.

/J\
-- 
Jonathan Stowe                      |
<http://www.gellyfish.com>          |      This space for rent
                                    |