Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Here is another shot at Tie::Static that takes into account considerable conversation with MeowChow, japhy and others. If nobody notices anything glaring wrong with it, it will go in my home directory as version 0.02.
package Tie::Static; use Exporter; @EXPORT_OK = 'static'; @ISA = 'Exporter'; $VERSION = 0.02; use strict; use vars qw(%call_count); use Carp; sub static { my $call = join "|", caller(); if ($call_count{$call}) { tie_all($call, @_); } else { my @init = map { (ref($_) eq "SCALAR" or ref($_) eq "REF") ? $$_ : (ref($_) eq "ARRAY") ? [@$_] : (ref($_) eq "HASH") ? { %$_ } : bad_ref($_); } @_; tie_all($call, @_); foreach my $to_replace(@_) { my $saved = shift @init; if (ref($to_replace) eq "SCALAR" or ref($to_replace) eq "REF") { $$to_replace = $saved; } elsif (ref($to_replace) eq "ARRAY") { @$to_replace = @$saved; } elsif (ref($to_replace) eq "HASH") { %$to_replace = %$saved; } else { $Carp::Verbose = 1; bad_ref($to_replace); } } } return $call_count{$call}++; } # The first argument is the value of $called to use, the # rest are references to the variables to tie. It ties # the variables to the appropriate static. sub tie_all { my $call = shift; my $uniq = 0; for (@_) { if (ref($_) eq "SCALAR" or ref($_) eq "REF") { tie ($$_, 'Tie::Static::Scalar', $call, $uniq++); } elsif (ref($_) eq "ARRAY") { tie (@$_, 'Tie::Static::Array', $call, $uniq++); } elsif (ref($_) eq "HASH") { tie (%$_, 'Tie::Static::Hash', $call, $uniq++); } else { bad_ref($_); } } } # Message for a bad reference in the argument. sub bad_ref { my $thing = shift; if (my $ref = ref($thing)) { croak("Cannot create static of unknown type $ref"); } else { croak("Arguments to static must be references!"); } } # Implement the ties foreach my $type (qw(Hash Array Scalar)) { my $meth = uc($type); my $pack = "Tie::Static::$type"; eval qq( package $pack; require Tie::$type; \@$pack\::ISA = 'Tie::Std$type'; sub TIE$meth { my \$class = shift; my \$call = join "|", \@_ ? \@_ : caller(); return \$$pack\::preserved{\$call} ||= \$class->SUPER::TIE$meth(); } sub Tie::Static::TIE$meth { shift; unshift \@_, 'Tie::Static::$type'; goto &$pack\::TIE$meth; } ) or die $@; } 1; __END__ =head1 NAME Tie::Static - create static lexicals =head1 SYNOPSIS # The tie-based approach use Tie::Static; sub foo { tie (my $static_scalar, 'Tie::Static'); tie (my @static_array, 'Tie::Static'); tie (my %static_hash, 'Tie::Static'); # do whatever you want } # The function call approach use Tie::Static qw(static); sub bar { static \ my ($scalar, @array, %hash); # etc } =head1 DESCRIPTION This module makes it easy to produce static variables. A static variable is a variable whose value will remain constant from invocation to invocation. The usual way to produce this is to create an enclosing scope which contains a lexically scoped variable. For instance the first example could be written as: { my $static_scalar; my @static_array; my %static_hash; sub foo { # Do whatever you want } } But while this works, many people find it cumbersome to have to produce new scopes manually just to get a static variables. This module provides an alternate solution by providing a way to make lexical variables be what they used to be. There are two interfaces. The low-level interface is to I<tie> your variable directly. But most of the time you will want to use the exportable I<static> function. If you I<tie> and do not pass any arguments, it will use the feedback from caller() to decide whether to tie you to a fresh variable, or whether to hand you back an old one. If you pass the I<tie> arguments, it will join them with "|" and use that key to decide what object to hand you back. This allows you to create static variables which are shared between functions in any way you want. What I<static> does is take a list of references to variables, tie them, and then report how many times they were previously tied. If the variables had not been tied before, I<static> will initialize the tied variables to the values they had before being tied. Therefore if you want to have default values for your static variables you can either initialize them before calling I<static>, or do the initialization if I<static> returns a false value. Here are examples: # Pre-initializing a static. my @array = 1..10; my %hash = (Hello => "World", Greetings => "Earthlings"); static \(@array, %hash); # Testing the return of static my $handle; unless (static(\$handle)) { $handle = complex_initialization(); } # Initializing while calling, only works with scalars static \(my $foo = "Hello", my $bar = "World"); =head1 LIMITATIONS AND NOTES This module relies on the output of [caller] to decide which value to give back. Specifically, it makes its decisions based on Perl's idea of the current package, filename, and line-number. Normally this is correct. But sometimes it is wrong. And occasionally it is very wrong. It is correct if there is only one call on any given line, and you want that call to always give you back the same values. It is wrong if you put 2 separate calls to I<static> or try to I<tie> the same data-type twice on one line. It is very wrong if you want to play with closures. It has no way to distinguish them. This only allows static scalars, arrays, and hashes. If you want to overload the implementation of a static, please note that scalars, arrays, and hashes are not tied to the package Tie::Static. Instead they are tied to the private packages Tie::Static::Scalar, Tie::Static::Array, and Tie::Static::Hash. =head1 CREDITS Thanks go to several people at http://www.perlmonks.org for discussions on how to implement this and what the API should look like. In particular "MeowChow" for analyzing the gotchas that people need to be aware of. Jeff "japhy" Pinyan (japhy@pobox.com) for discussion on implementations and the idea of I<static>. And "HyperZonk" and Charles "Wog" Reiss for general discussion. The idea of initializing scalars as you call I<static> is Wog's. And a particular note should be made of all of the people on p5p, PerlMonks, and elsewhere who saw the behaviour of my $foo if 0; as a feature rather than a bug. Without you I would not have been inspired to write an (intentional) implementation of statics for Perl. =head1 AUTHOR AND COPYRIGHT Ben Tilly (ben_tilly@operamail.com) Copyright 2001. This may be modified and distributed on the same terms as Perl.

In reply to Tie::Static take 2 by tilly
in thread Tie::Static by tilly

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (8)
As of 2024-03-28 18:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found