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:

• Existing code can stay the same, you just need to tie() the global variables.
• Existing init routines can be reused.
• If you pass in a fully qualified name for a package global or a reference to a lexical variable as an additional argument to the FETCH method, the tie to this variable will be undone after first use. (Thanks to tilly for pointing out this works with lexicals, too!)

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";
[download]

Christian Lemburg
Brainbench MVP for Perl
http://www.brainbench.com