view release on metacpan or  search on metacpan

IPC/Lite.pm  view on Meta::CPAN

package IPC::Lite;

# Combination of vars.pm, Tie::DBI, and IPC
# Wanted to called it "shared" .... ie: "use shared qw($var)"
# but shared memory is sketchy at best, whereas SQLite works
# on most platforms

our $VERSION = '0.5.' . [qw$Revision: 40 $]->[1];

use warnings::register;
use strict;

#use strict qw(vars subs);

use DBI;
use DBD::SQLite;

# Can set this directly if desired

our %DEFAULT_PATH;
our %DEFAULT_TTL;
our %DEFAULT_KEY;
our $DEBUG;

my %DBS;

#$SIG{__DIE__} = \&fatalerror;

# this code from vars.pm, since we can't adjust the "callpack"
sub import {
#hereiam();
    my $callpack = caller;
    my ($pack, @imports) = @_;
    my ($sym, $ch, $sym_n);
    my %opts;
   
    my $imps;
 
    my $i = -1;
    foreach (@imports) {
	++$i;
        if (($ch, $sym) = /^([\$\@\%])(.+)/) {
	    no strict 'refs';
	    no warnings 'uninitialized';
	    if ($sym =~ /\W/) {
		# time for a more-detailed check-up
		if ($sym =~ /^\w+[[{].*[]}]$/) {
		    require Carp;
		    Carp::croak("Can't declare individual elements of hash or array");
		} elsif (warnings::enabled() and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
		    warnings::warn("No need to declare built-in vars");
		} elsif  (($^H &= strict::bits('vars'))) {
		    require Carp;
		    Carp::croak("'$_' is not a valid variable name under strict vars");
		}
	    }
	    # don't put "main::" on every table entry, too ugly
	    $sym_n = $sym;
	    $sym = "${callpack}::$sym" unless $sym =~ /::/;
	    $sym_n = $sym unless $callpack eq 'main';		
	    *$sym =
		(  $ch eq "\$" ? \$$sym
		 : $ch eq "\@" ? \@$sym
		 : $ch eq "\%" ? \%$sym
		 : do {
		     require Carp;
		     Carp::croak("'$_' is not a valid variable name");
		 });
	    eval("tie ${ch}$sym, '$pack', \%opts, sym=>'$sym_n';");
	    if ($@) {
                    require Carp;
                    Carp::croak("'$_' problem with tie: $@");
	    }
	    ++$imps;
	} else {
	    if ($_ =~ /^(ttl|timeout)$/i) {
		$opts{ttl} = splice @imports, $i+1, 1;
		$opts{ttl} = $1 if $opts{ttl} =~ s/\s*\b(\d+)(s|\s*seconds)\b\s*//;
		$opts{ttl} = 86400 * $1 + ($opts{ttl} ? $opts{ttl} : 0) if $opts{ttl} =~ s/\s*\b(\d+)(d|\s*days)\b\s*//;
		next;
	    }
            if ($_ =~ /^path$/i) {
                $opts{path} = splice @imports, $i+1, 1;
                next;
            }
            if ($_ =~ /^key$/i) {
                $opts{key} = splice @imports, $i+1, 1;
                next;
            }
	    require Carp;
	    Carp::croak("'$_' is not a valid variable name for $pack");
	}
    }

    # assume user wanted to set global defaults instead
    if (!$imps) {
    	$DEFAULT_PATH{$callpack} = $opts{path} if $opts{path};
    	$DEFAULT_TTL{$callpack} = $opts{ttl} if $opts{ttl};
    	$DEFAULT_KEY{$callpack} = $opts{key} if $opts{key};
    }
};


#### public methods

sub path {
	return $_[0]->{path};
}

sub db {
        return $_[0]->{db};
}