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

savevars documentation Contained in the savevars distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

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

DESCRIPTION

Top

This module will, like 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.

FUNCTIONS

Top

cfgfile

Return the pathname of the current configuration file.

writecfg

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

dont_write_cfgfile

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

NOTES

Top

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.

CAVEATS

Top

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

BUGS

Top

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 $HOME environment variable exists, in the $HOME directory.

AUTHOR

Top

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.

SEE ALSO

Top

vars.

savevars documentation Contained in the savevars distribution. 
# -*- perl -*-

#
# $Id: savevars.pm,v 1.13 2002/02/11 00:20:12 eserte Exp $
# Author: Slaven Rezic
#
# 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.
#
# 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__