"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Tie/Scalar.pm" (18 Apr 2017, 4164 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package Tie::Scalar;
    2 
    3 our $VERSION = '1.04';
    4 
    5 =head1 NAME
    6 
    7 Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
    8 
    9 =head1 SYNOPSIS
   10 
   11     package NewScalar;
   12     require Tie::Scalar;
   13 
   14     @ISA = qw(Tie::Scalar);
   15 
   16     sub FETCH { ... }       # Provide a needed method
   17     sub TIESCALAR { ... }   # Overrides inherited method
   18 
   19 
   20     package NewStdScalar;
   21     require Tie::Scalar;
   22 
   23     @ISA = qw(Tie::StdScalar);
   24 
   25     # All methods provided by default, so define
   26     # only what needs be overridden
   27     sub FETCH { ... }
   28 
   29 
   30     package main;
   31 
   32     tie $new_scalar, 'NewScalar';
   33     tie $new_std_scalar, 'NewStdScalar';
   34 
   35 =head1 DESCRIPTION
   36 
   37 This module provides some skeletal methods for scalar-tying classes. See
   38 L<perltie> for a list of the functions required in tying a scalar to a
   39 package. The basic B<Tie::Scalar> package provides a C<new> method, as well
   40 as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar>
   41 package provides all the methods specified in  L<perltie>. It inherits from
   42 B<Tie::Scalar> and causes scalars tied to it to behave exactly like the
   43 built-in scalars, allowing for selective overloading of methods. The C<new>
   44 method is provided as a means of grandfathering, for classes that forget to
   45 provide their own C<TIESCALAR> method.
   46 
   47 For developers wishing to write their own tied-scalar classes, the methods
   48 are summarized below. The L<perltie> section not only documents these, but
   49 has sample code as well:
   50 
   51 =over 4
   52 
   53 =item TIESCALAR classname, LIST
   54 
   55 The method invoked by the command C<tie $scalar, classname>. Associates a new
   56 scalar instance with the specified class. C<LIST> would represent additional
   57 arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
   58 complete the association.
   59 
   60 =item FETCH this
   61 
   62 Retrieve the value of the tied scalar referenced by I<this>.
   63 
   64 =item STORE this, value
   65 
   66 Store data I<value> in the tied scalar referenced by I<this>.
   67 
   68 =item DESTROY this
   69 
   70 Free the storage associated with the tied scalar referenced by I<this>.
   71 This is rarely needed, as Perl manages its memory quite well. But the
   72 option exists, should a class wish to perform specific actions upon the
   73 destruction of an instance.
   74 
   75 =back
   76 
   77 =head2 Tie::Scalar vs Tie::StdScalar
   78 
   79 C<< Tie::Scalar >> provides all the necessary methods, but one should realize
   80 they do not do anything useful. Calling C<< Tie::Scalar::FETCH >> or 
   81 C<< Tie::Scalar::STORE >> results in a (trappable) croak. And if you inherit
   82 from C<< Tie::Scalar >>, you I<must> provide either a C<< new >> or a
   83 C<< TIESCALAR >> method. 
   84 
   85 If you are looking for a class that does everything for you you don't
   86 define yourself, use the C<< Tie::StdScalar >> class, not the
   87 C<< Tie::Scalar >> one.
   88 
   89 =head1 MORE INFORMATION
   90 
   91 The L<perltie> section uses a good example of tying scalars by associating
   92 process IDs with priority.
   93 
   94 =cut
   95 
   96 use Carp;
   97 use warnings::register;
   98 
   99 sub new {
  100     my $pkg = shift;
  101     $pkg->TIESCALAR(@_);
  102 }
  103 
  104 # "Grandfather" the new, a la Tie::Hash
  105 
  106 sub TIESCALAR {
  107     my $pkg = shift;
  108     my $pkg_new = $pkg -> can ('new');
  109 
  110     if ($pkg_new and $pkg ne __PACKAGE__) {
  111         my $my_new = __PACKAGE__ -> can ('new');
  112         if ($pkg_new == $my_new) {  
  113             #
  114             # Prevent recursion
  115             #
  116             croak "$pkg must define either a TIESCALAR() or a new() method";
  117         }
  118 
  119     warnings::warnif ("WARNING: calling ${pkg}->new since " .
  120                           "${pkg}->TIESCALAR is missing");
  121     $pkg -> new (@_);
  122     }
  123     else {
  124     croak "$pkg doesn't define a TIESCALAR method";
  125     }
  126 }
  127 
  128 sub FETCH {
  129     my $pkg = ref $_[0];
  130     croak "$pkg doesn't define a FETCH method";
  131 }
  132 
  133 sub STORE {
  134     my $pkg = ref $_[0];
  135     croak "$pkg doesn't define a STORE method";
  136 }
  137 
  138 #
  139 # The Tie::StdScalar package provides scalars that behave exactly like
  140 # Perl's built-in scalars. Good base to inherit from, if you're only going to
  141 # tweak a small bit.
  142 #
  143 package Tie::StdScalar;
  144 @ISA = qw(Tie::Scalar);
  145 
  146 sub TIESCALAR {
  147     my $class = shift;
  148     my $instance = @_ ? shift : undef;
  149     return bless \$instance => $class;
  150 }
  151 
  152 sub FETCH {
  153     return ${$_[0]};
  154 }
  155 
  156 sub STORE {
  157     ${$_[0]} = $_[1];
  158 }
  159 
  160 sub DESTROY {
  161     undef ${$_[0]};
  162 }
  163 
  164 1;