Would something like this suite your needs (demo just for scalar variables)?
Approach: tie() builds up a mapping between tied objects and fully qualified subroutine names. When the tied object is asked for its value, we call the subroutine with the name passed when tie()ing the object. This subroutine caches the object's value.
Benefits:
Update: I see you called for something more - untie()ing the object after first use. For lexical ("my") variables, I don't currently see how to do this, since we have no access to them inside the FETCH function (Ah, we *can* have that - thanks tilly again - see above). For true package globals, it's easy: just set the (in this case scalar) entry of the glob in the package you call the FETCH from to the new value and remove the tie(). Hm ... let's see if this works ... yup it does!
Demo code:
#!/usr/bin/perl -w use strict; # show how to tie scalars existing init routines the lazy way $| = 1; # -------------------------------------------------- package LegacyRoutines; use vars qw($AUTOLOAD); sub foo { print __PACKAGE__ . "::foo magically called\n"; return 42; } sub baz { print __PACKAGE__ . "::baz magically called\n"; return "hooray"; } # no bar routine here - catch errors sub AUTOLOAD { "LegacyRoutines: undefined subroutine $AUTOLOAD called\n"; } # -------------------------------------------------- package MyGlobals; # global to map objects to associated init routine names my %mappings; # global to memorize package globals to initialize my %vars; sub TIESCALAR { my $class = shift; my ($name, $var) = @_; bless \ (my $self), $class; $mappings{\$self} = $name; $vars{\$self} = $var; return \$self; } sub FETCH { print __PACKAGE__ ."::FETCH called\n"; # $_[0] - alias to original object ref we stored in %mappings my $value; if (not defined ${$_[0]}) { print "Initializing $_[0] ... \n"; # check if we have an entry for that object if (not exists $mappings{$_[0]}) { print "No matching subroutine for ", $_[0], "\n"; return $_[0]; } # call to init routine associated with $self no strict 'refs'; # set original value ${$_[0]} = &{ $mappings{$_[0]} }(); # remember it $value = ${$_[0]}; # untie package global if (exists $vars{$_[0]}) { untie ${$vars{$_[0]}}; } return $value; } return ${$_[0]}; } sub STORE { # whatever you want } sub DESTROY { # whatever you want } # -------------------------------------------------- package main; use vars qw($foo); tie($foo, "MyGlobals", "LegacyRoutines::foo", "main::foo"); tie(my $bar, "MyGlobals", "LegacyRoutines::bar"); tie(my $baz1, "MyGlobals", "LegacyRoutines::baz"); tie(my $baz2, "MyGlobals", "LegacyRoutines::baz"); # make $baz2 a de-facto alias to $baz1 print $foo, "\n"; print $foo, "\n"; print $bar, "\n"; print $baz1, "\n"; print $baz1, "\n"; print $baz2, "\n"; print $baz2, "\n";
Christian Lemburg
Brainbench MVP for Perl
http://www.brainbench.com
In reply to Re: Using tie to initialize large datastructures
by clemburg
in thread Using tie to initialize large datastructures
by htoug
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |