/usr/local/CPAN/NCAR/NCAR/COMMON.pm

• package NCAR::COMMON
  • import
  • TIEHASH
  • FETCH
  • STORE
  • CLEAR
  • DELETE
  • EXISTS
  • FIRSTKEY
  • NEXTKEY
• EOF

package NCAR::COMMON;

our $VERSION = '0.01';

use strict;
use Carp qw( croak );

sub import {
  my $package = shift;
  my @C = @_;
  my $caller = caller;
  for( @C ) {
    s/^%//o;
    eval {
      require "NCAR/COMMON/$_.pl";
    };
    $@ && croak( "Undefined NCAR::COMMON $_" );
    no strict 'refs';
    *{"$caller\::$_"} = \%{"NCAR::COMMON::$_"};
  }
}



sub TIEHASH {
  my $class = shift;
  my %args = @_;
  return bless { 
           name    => $args{-name}, 
           id      => $args{-id}, 
           vars    => $args{-vars},
         }, $class;
}

sub FETCH {
  my ( $self, $key, $value ) = @_;
  croak( "$key not defined in NCAR::COMMON::$self->{name}" )
  unless( exists $self->{vars}{$key} );
  &NCAR::ncar_common_variable_get( 
        $self->{id}, 
        $value, 
        $self->{vars}{$key}[0], 
        $self->{vars}{$key}[1],
        $self->{vars}{$key}[2],
        $self->{vars}{$key}[3],
  );
  return $value;
}

sub STORE {
  my ( $self, $key, $value ) = @_;
  croak( "$key not defined in NCAR::COMMON::$self->{name}" )
  unless( exists $self->{vars}{$key} );
  croak( "Cannot set a non-scalar value in NCAR::COMMON::$self->{name}" )
  if( @{ $self->{vars}{$key}[3] } );
  &NCAR::ncar_common_variable_set( 
        $self->{id}, 
        $value, 
        $self->{vars}{$key}[0], 
        $self->{vars}{$key}[1],
        $self->{vars}{$key}[2],
  );
  return $value;
}

sub CLEAR {

}

sub DELETE {

}

sub EXISTS {
  my ( $self, $key, $value ) = @_;
  exists $self->{vars}{$key};
}

sub FIRSTKEY {
  my ( $self, $key, $value ) = @_;
  each %{ $self->{vars} };
}

sub NEXTKEY {
  my ( $self, $key, $value ) = @_;
  each %{ $self->{vars} };
}

1;