view release on metacpan or  search on metacpan

savevars.pm  view on Meta::CPAN

#
# Mail: eserte@cs.tu-berlin.de
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

package savevars;

$VERSION = "0.07";

# parts stolen from "vars.pm"

my $has_data_dumper = 0;
eval {
    require Data::Dumper;
    $has_data_dumper = 1;
};

my @imports;
my $callpack;
my $dont_write_cfgfile = 0;
my $cfgfile;

sub import {
    $callpack = caller;
    my $pack = shift;
    @imports = @_;
    my($sym, $ch);
    foreach my $s (@imports) {
        if ($s =~ /::/) {
            require Carp;
            Carp::croak("Can't declare another package's variables");
        }
        ($ch, $sym) = unpack('a1a*', $s);
        *{"${callpack}::$sym"} =
          (   $ch eq "\$"                       ? \$ {"${callpack}::$sym"}
	   : ($ch eq "\@" and $has_data_dumper) ? \@ {"${callpack}::$sym"}
	   : ($ch eq "\%" and $has_data_dumper) ? \% {"${callpack}::$sym"}
	   : do {
	       require Carp;
	       if (!$has_data_dumper) {
		   Carp::croak("Can't handle variable '$ch$sym' without module Data::Dumper.\n");
	       } else {
		   Carp::croak("Can't handle variable '$ch$sym'.\n");
	       }
	   });
    }

    my $cfgfile = cfgfile();
    if (-r $cfgfile) {
	require Safe;
	my $cpt = new Safe;
	$cpt->permit(qw(:base_core));
	$cpt->share_from($callpack, \@imports);
	$cpt->rdo($cfgfile);
    }
}

sub cfgfile {
    if (!defined $cfgfile) {
	my $basename = ($0 =~ m|([^/\\]+)$| ? $1 : $0);
	$cfgfile = eval { (getpwuid($<))[7] } || $ENV{'HOME'} || '';
	if ($cfgfile eq '' && $^O eq 'MSWin32') {
	    $cfgfile = 'C:';
	}
	$cfgfile .= "/.${basename}rc";
    }
    $cfgfile;
}

sub writecfg {
    my $cfgfile = cfgfile();
    if (open(CFG, ">$cfgfile")) {
	foreach my $_sym (@imports) {
	    my($ch, $sym) = unpack('a1a*', $_sym);
	    if ($has_data_dumper) {
		my($ref, $varname);
		if ($ch eq "\$") {
		    $ref = eval "$ch${callpack}::$sym";
		    $varname = "${callpack}::$sym";
		} else {
		    $ref = eval "\\" . "$ch${callpack}::$sym";
		    $varname = "*${callpack}::$sym";
		}
		print CFG Data::Dumper->Dump([$ref], [$varname]);
	    } else {
		if ($ch eq "\$") {
		    my $var = "${callpack}::$sym";
		    my $val = eval '$$var';
		    next if !defined $val;
		    $val =~ s/([\'\\])/\\$1/g;
		    print CFG "\$" . $callpack . "::" . $sym . " = '$val';\n";
		} else {
		    die;
		}
	    }
	}
	close CFG;
	1;
    } else {
	warn "Can't write configuration file $cfgfile";
	0;
    }
}

sub dont_write_cfgfile {
    $dont_write_cfgfile = 1;
}

END {
    writecfg() unless $dont_write_cfgfile;
}

1;

__END__

=head1 NAME

savevars - Perl pragma to auto-load and save global variables

=head1 SYNOPSIS

    use savevars qw($frob @mung %seen);

=head1 DESCRIPTION

This module will, like C<use vars>, predeclare the variables in the
list. In addition, the listed variables are retrieved from a
per-script configuration file and the values are stored on program
end. The filename of the configuration file is
"$ENV{HOME}/.${progname}rc", where progname is the name of the current
script.

The values are stored using the Data::Dumper module, which is already
installed with perl5.005 and better.

=head1 FUNCTIONS

=head2 cfgfile

Return the pathname of the current configuration file.

=head2 writecfg

Write the variables to the configuration file. This method is called
at END.

=head2 dont_write_cfgfile

If this function is called, then the configuration file will not be
written at END.

=head1 NOTES

If you want to be nice to your users and do not want to require them
to install this module, you can use this snippet of code to use the
savevars or the vars module, whatever is available:

    BEGIN {
        my @vars = qw($var1 $var2 @var3 %var4);
        eval           q{ use savevars @vars };
        if ($@) { eval q{ use vars     @vars } }
    }

Just put all the variables to be saved into the @vars array.

=head1 CAVEATS

cfgfile() uses the $< variable to determine the current home
directory. This might not be what you want if using setuid scripts.

=head1 BUGS

Because getpwuid() is used, this module will not work very well on
Windows. Configuration files will be stored in the current drive root
directory or, if the C<$HOME> environment variable exists, in the
C<$HOME> directory.

=head1 AUTHOR

Slaven Rezic <eserte@cs.tu-berlin.de>

Copyright (c) 1998-2001 Slaven Rezic. All rights reserved. This
package is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<vars>.

=cut