File Coverage

blib/lib/Envy/DB.pm

Criterion	Covered	Total	%
statement	407	522	77.9
branch	221	336	65.7
condition	89	145	61.3
subroutine	45	52	86.5
pod	0	39	0.0
total	762	1094	69.6

# ------------------------------------------------------*-perl-*-
# GHOSTWHEEL DIMENSION MULTIPLEXER
#
use strict;
package Envy::DB;
use integer;
use Carp;
use Symbol;
use Fcntl;
use vars qw(@ISA @EXPORT_OK $VERSION $EVERSION @DefaultPath
	    $MAX_VAR_LENGTH
	    $LOGIN $Context $NestLevel $Loop $Path @FORCEPATH %PASSWD);
$VERSION = '2.48';
$NestLevel = 0;

umask 0;  # Figure out how to run setuid 'envy'? XXX

$MAX_VAR_LENGTH = 969;  # configure time parameter?

$EVERSION = 4;  # environment variable protocol version

sub EVERSION()    { 'ENVY_VERSION'   }
sub PATH()        { 'ENVY_PATH'      }
sub STATE()       { 'ENVY_STATE'     }
sub DIMENSION()   { 'ENVY_DIMENSION' }
sub CONTEXT()     { 'ENVY_CONTEXT'   }
sub VERBOSE()     { 'ENVY_VERBOSE'   }

if ($ENV{REGRESSION_ENVY_PATH}) {
    @DefaultPath = split m/\s+/, $ENV{REGRESSION_ENVY_PATH};
    @FORCEPATH = ();
} else {
    @DefaultPath = qw(/usr/local/etc/envy)
	;
    @FORCEPATH = qw(/bin /usr/bin)
	;
}

sub new { #PUBLIC
    my ($class, $env) = @_;
    my $o = bless {}, $class;
    my %env = $env? %$env : ();
    $o->{orig} = \%env;
    $o->{where} = $o->{env}{ &CONTEXT } || 'shell';
    $o->{desc} = {};
    $o->{transaction} = 0;
    $o->{warnlevel} = $o->{env}{ &VERBOSE } || 1;
    $o->begin;
    $o;
}

# help cope with backward compatibility
sub version {
    my ($o) = @_;
    $o->{env}{&EVERSION} || $EVERSION;
}

# ---------------------------------------------------------------
# MESSAGES

sub warnlevel {
    my $o=shift;
    if (@_) {
	$o->{warnlevel} = shift;
    } else {
	$o->{warnlevel}
    }
}

sub e { my $o=shift; _internal_warn($o, 0, 1, @_) }   # abort transaction
sub w { my $o=shift; _internal_warn($o, 1, 1, @_) }   # manditory warning
sub n { my $o=shift; _internal_warn($o, 2, 1, @_) }   # optional warning
sub t { my $o=shift; _internal_warn($o, 3, 0, @_) }   # trace execution
sub d { my $o=shift; _internal_warn($o, 4, 0, @_) }   # debugging info

sub _internal_warn {
    my ($o, $level, $show_context) = splice @_, 0, 3;
    my $w = join('', @_);
    if ($show_context) {
	$w .= $Context
	    if $Context && $w !~ m/\n$/s;
    } else {
	$w = 'D ' . ('  'x$NestLevel).$w;
    }
    $w .= "\n" if $w !~ m/\n$/s;
    if ($level <= $o->{strictness}) {
	$w = 'ERROR: '.$w;
	++$o->{errors};
    }
    push @{$o->{'warn'}}, $w
	if $level <= $o->{warnlevel};
    0
}

# ---------------------------------------------------------------
# GENERIC UTILITIES

sub diff_hash { #PUBLIC
    my ($orig,$env) = @_;
    my %delta;
    for my $k (keys(%$orig), keys(%$env)) {
	if (!exists $$orig{$k}) {
	    $delta{$k} = $env->{$k};
	} elsif (!exists $$env{$k}) {
	    $delta{$k} = undef;
	} elsif ($$orig{$k} ne $$env{$k}) {
	    $delta{$k} = $$env{$k};
	}
    }
    \%delta;
}

# ---------------------------------------------------------------
# ENVY_PATH MANAGEMENT

sub search_envy_path { #PRIVATE
    my ($o) = @_;
    $o->{fullpath} = {};
    $o->{shadowed} = {};

    my %PATH;
    my $add_path  = sub {
	my ($o, $p) = @_;

	return if exists $PATH{$p};
	$PATH{$p}=1;
	$o->d("Reading $p...\n");

	my $dh = gensym;
	opendir($dh, $p) or return $o->n("Directory '$p' not readable.\n");
	for my $m (readdir($dh)) {
	    next if $m !~ m/\.(mo|env)$/;
	    next if -d "$p/$m";

	    if ($m =~ /[,\s]/) {
		$o->w("Envy found containing commas '$p/$m' (ignored).\n");
		next;
	    }
	    $o->w("Envy '$p/$m' should have .env suffix (ignored).\n")
		if $m !~ m/\.env$/;

	    my $file = $m;
	    $m =~ s/\.(mo|env)$//;
	    if ($m =~ m/^\d$/) {
		$o->w("Envy: '$p/$m' single digits are reserved\n");
		next;
	    }
	    if (!exists $o->{fullpath}{$m}) {
		#$o->d("\t$m=$p/$file\n"); emergency debugging
		$o->{fullpath}{$m} = "$p/$file";
	    } else {
		push @{ $o->{shadowed}{$m} }, "$p/$file";
	    }
	}
	closedir($dh);
    };

    my @add = split /:+/, $o->{env}{&PATH}||'';
    @add = @DefaultPath if !@add;
    if (exists $o->{env}{'HOME'} and -d $o->{env}{'HOME'}."/.envy") {
	unshift @add, $o->{env}{'HOME'}."/.envy";
    }
    for my $p (@add) {
	$add_path->($o, $p);
	if (-d "$p/.priv") {
	    $add_path->($o, "$p/.priv")
	} elsif (-d "$p/.private") { # remove deprecated XXX
	    $o->w("$p/.private should be renamed to $p/.priv\n");
	    $add_path->($o, "$p/.private");
	}
    }
}

sub get_fullpath {
    my ($o, $mo) = @_;
    $o->search_envy_path() if !exists $o->{fullpath};
    if (!defined $mo) {
	$o->{fullpath}
    } elsif (exists $o->{fullpath}{$mo}) {
	$o->{fullpath}{$mo}
    } elsif (-f $mo) {
	# I think this is a hack for cache_shell_script? XXX
	#$o->n("Using '$mo' from the current working directory");
	$mo
    } else {
	()
    }
}

# ---------------------------------------------------------------
# TRANSACTIONS

sub begin { #PUBLIC
    my ($o) = @_;
    return if $o->{transaction};

    my @env = %{ $o->{orig} };
    $o->{env} = { @env };
    $o->{delta} = undef;
    $o->{'warn'} = [];
    $o->{'log'} = [];
    $o->{errors} = 0;
    $o->{strictness} = 0
	;
    my $v = $o->version;
    $o->w("Envy protocol $v is not supported in this version of Envy (v$VERSION).\nPlease consider upgrading to the latest version!\n")
	if $v > $EVERSION;

    for my $k (&STATE, &DIMENSION) {
	$o->join_variable($k);
    }

    my %loaded;
    for my $m (split /:+/, $o->{env}{&STATE} || '') {
	my ($k,$v) = split /,/, $m;
	$v = '0' if $v eq 'STARTUP'; # v1.18?
	$loaded{$k}=$v;
    }
    $o->{loaded} = \%loaded;

    my %dimen = map { split /,/ } split /:+/, $o->{env}{&DIMENSION} || '';
    $o->{dimen} = \%dimen;
    $o->{first} = $o->{dimen}{First};
    $o->{transaction} = 1;
}

sub commit { #PUBLIC
    my ($o) = @_;
    confess "not in transaction" if $o->{transaction}!=1;
    $o->{transaction} = 0;
    return 1 if $o->{errors};

    # ENVY_PATH is adjusted just like other variables (almost).
    # It does not concern us here.

    my $dim = $o->{dimen};
    $o->{env}{&EVERSION} = $EVERSION;
    $o->{env}{&STATE} = join(':', map {"$_,$o->{loaded}{$_}"} sort
			     keys %{$o->{loaded}});
    $o->{env}{&DIMENSION} = join(':', map {"$_,$o->{dimen}{$_}"} sort
				 grep { defined $dim->{$_} } keys %$dim);
    for my $k (&STATE, &DIMENSION) {
	$o->split_variable($k)
    }

    $o->{delta} = diff_hash($o->{orig}, $o->{env});
    $o->{orig} = $o->{env};
    $o->{env} = undef;
    0;
}

# ---------------------------------------------------------------
# ENVY_STATE & ENVY_DIMENSION API

sub is_first {
    if (@_ == 1) {
	my ($o) = @_;
	!$o->{dimen}{First}    # true if never seen 'First'
    } elsif (@_ == 2) {
	my ($o, $mo) = @_;
	my $f = $o->{dimen}{First};
	$f && $f eq $mo
    }
}

# Explaination of reference counting scheme:
#
# 0      - the first envy loaded (First dimension)
# 1      - top level (refcnt=1)
#  - explicit dependency (refcnt=1)
# 2+     - required by multiple envys

sub get_seniority { #PRIVATE
    my ($o, $e) = @_;
    my $rc = $o->{loaded}{$e};
    return 0 if !$rc;
    return 1 if $rc eq '1';
    return 2 if $rc !~ m/^\d+$/;
    return 2+$rc;
}
sub get_refcnt { #PRIVATE
    my ($o, $e) = @_;
    return 0 if !exists $o->{loaded}{$e};
    my $rc = $o->{loaded}{$e};
    $rc = 1 if $rc eq '0' || $rc !~ m/^\d+$/;
    $rc;
    # dualvar? XXX
}
sub set_refcnt { #PRIVATE
    my ($o,$e,$rc) = @_;
    if ($rc <= 0) {
	delete $o->{loaded}{$e};
    } else {
	$o->{loaded}{$e} = $rc;
    }
}

sub refcnt_inc { #PRIVATE
    my ($o, $e, $by) = @_;
    my $l = $o->{loaded};
    if ($o->is_first($e)) {
	$l->{$e} = '0';   # cannot increase, emit warning? XXX
    } elsif (!exists $l->{$e}) {
	$l->{$e} = $by;
    } else {
	$l->{$e} = $o->get_refcnt($e)+1;
    }
}

sub refcnt_dec { #PRIVATE
    my ($o, $e, $by) = @_;
    my $rc = $o->get_refcnt($e);
    if ($rc <= 1) {
	my $old = $o->{loaded}{$e};
	$o->n("Envy '$e' unloaded by '$by' instead of '$old'")
	    if ($old and $old !~ m/^\d+$/ and $old ne $by);
	delete $o->{loaded}{$e}
    } else {
	$o->{loaded}{$e} = $rc - 1;
    }
}

sub nav_dimension { #PRIVATE
    my ($o, $how, $di, $by) = @_;
    my $swap;
    my $old = $o->{dimen}{$di} if exists $o->{dimen}{$di};
    if ($how>0) {
	if ($o->is_first) {
	    if ($di ne 'First') {
		$o->w("Envy '$by' should claim dimension 'First' instead of '$di'");
		$di = 'First';
	    }
	}
	else {
	    if ($di eq 'First') {
		if ($by eq $o->{first}) {
		    $o->n("First dimension '$by' reloaded") #is harmless?
			if !$o->{unload_all};
		} else {
		    $o->unload_all()
		}
	    }
	    if ($old and $old ne $by) {
		$o->n("Swapping $di from '$old'");
		$swap = $o->get_refcnt($old);
		$o->process_envy(-100, $di, $di);
	    }
	}
	$o->{dimen}{$di} = $by;
	$o->{first} = $by
	    if $di eq 'First';
    } else {
	if (0) {
	    # only positive transitions
	    $o->w("Envy '$by' releasing $di (was '$old')")
		if $old && $old ne $by;  # unlikely to occur
	    $o->{dimen}{$di} = undef;    # don't delete!
	}
    }
    $swap;
}

# ---------------------------------------------------------------

sub catalogue {
    my($o) = shift;
    $o->{desc} = {}; #reset
    $o->search_envy_path() if !exists $o->{fullpath};
    my $fh = gensym;
    foreach my $mo (keys %{$o->{fullpath}}){
	my @file;
	# if we are going to touch the file-system, we might as
	# well load the dimension/dependency information too? XXX
	if(open($fh,$o->{fullpath}{$mo})){
	    @file = <$fh>;
	    close $fh;
	}
	chomp(@file);
	my(@desc) = grep(s/^desc(ription)?\s+//,@file);
	if((defined $o->{desc}{$mo}) && ($o->{desc}{$mo} ne "")){
	    $o->{desc}{$mo} = join("\n",$o->{desc}{$mo},@desc);
	} else {
	    $o->{desc}{$mo} = join("\n",@desc);
	}
    }
}

# ---------------------------------------------------------------
# VARIABLE SUBSTITUTION, ETC

sub tree_top {
    my ($base) = @_;
    $base =~ s,(/etc/envy|/mo|)/[^/]+\.(mo|env)$,,;
    $base;
}

# Split up a var if it is too large for the shell to handle
sub split_variable { # PRIVATE
    my($o,$k) = @_;
    return if length $o->{env}{$k} < $MAX_VAR_LENGTH;
    my @var = split /:+/, $o->{env}{$k};
    return if @var <= 1; # gasp!
    delete $o->{env}{$k};
    my @chunk;
    my $chunk=1;
    my $csz=0;
    my $save_chunk = sub {
	my $ck = "$k$chunk";
	if (exists $o->{env}{$ck}) {
	    $o->n("Stomping '$ck' while storing very long '$k'")
	}
	$o->{env}{$ck} = join ':', @chunk;
	@chunk=();
	$csz=0;
	++$chunk;
    };
    while (@var) {
	my $c = shift @var;
	&$save_chunk if @chunk && length($c) + $csz > $MAX_VAR_LENGTH;
	push @chunk, $c;
	$csz += length $c;
    }
    &$save_chunk if @chunk;
}

# put a var back together if it was split due
# to being too large for the shell to handle
sub join_variable { # PRIVATE
    my ($o,$k) = @_;
    return if exists $o->{env}{$k};
    my @c;
    for (my $c=1; exists $o->{env}{"$k$c"}; $c++){
	push @c, $o->{env}{"$k$c"};
	delete $o->{env}{"$k$c"};
    }
    $o->{env}{$k} = join(':', @c) || '';
}

sub interpolate {
    my ($o, $qx, $str) = @_;
    my $subst = sub {
	my $var = shift;
	$var =~ tr [{}] []d;
	# removed deprecated XXX
	if ($var eq 'MODULE_BASE' or $var eq 'modulebase' or
	    $var eq 'ENVY_LINKBASE') {
	    $o->w("$var is deprecated")
		if $var =~ /module/i;
	    return tree_top($Path);
	} elsif ($var eq 'MODULE_REALBASE' or $var eq 'ENVY_BASE') {
	    $o->w("$var is deprecated")
		if $var =~ /module/i;
	    my $rbase = $Path;
	    while (-l $rbase) {
		my $link = readlink($rbase) or die "readlink $rbase";
		if ($link =~ m,^/,) {
		    $rbase = $link    # absolute path
		} else {
		    # collapse ../
		    $rbase =~ s,/([^/]+)$,/,;
		    my $envy = $1;
		    $link =~ s,/.+?$,/,;
		    while ($link =~ s,\.\./$,,) {
			$rbase =~ s,/[^/]+/$,/,;
		    }
		    $rbase .= $link . $envy;
		}
	    }
	    return tree_top($rbase);
	} elsif ($var =~ m/^ENVY_(R|E)UID([_\w]*)$/) {
	    my $id = $1 eq 'R'? $< : $>;
	    my $field = $2;
	    my $pw = $PASSWD{$id} ||= [getpwuid($id)];
	    my $got = do {
		if ($field eq '') {
		    $id
		} elsif ($field eq '_NAME') {
		    $pw->[0]
		} elsif ($field eq '_GID') {
		    $pw->[3]
		} elsif ($field eq '_GCOS') {
		    $pw->[6]
		} elsif ($field eq '_DIR') {
		    $pw->[7]
		} elsif ($field eq '_SHELL') {
		    $pw->[8]
		} else {
		    $o->w("Builtin '$var' unrecognized");
		    ''
		}
	    };
	    return $got;
	}
	return $o->e("Variable '$var' unset for interpolation"), '' if
	    !defined $o->{env}{$var};
	$o->{env}{$var};
    };
    # need to do real lexical analysis XXX
    if($str =~ /^\'(.*)\'$/){
	return $1;
    }
    if($str =~ /\`(.*)\`$/){
      my(@asBackTic) = `$1`;
      chomp(@asBackTic);
      my($sBackTic) = join(" ",@asBackTic);
      $str =~ s/\`(.*)\`/$sBackTic/;
    }
    while ($str =~ s/
	   \$ (
	       (:? \{[\w-]+\} ) |
	       (:?   [\w-]+   )
	       )
	   /&$subst($1)/exg) {};
    $str;
}

sub edit_key {
    my ($o, $k) = @_;
    if ($k eq 'MODULE_PATH') {
	$o->w("'$k' is deprecated; please use ".&PATH);
	$k = &PATH;
    }
    return $o->w("Variable '$k' is not alpha-numeric") if
	$k !~ /^[\w-]+$/;
    return $o->w("Naughty: '$k' is private") if
	($k eq &STATE or $k eq &DIMENSION or
	 $k eq 'ENVY_BASE' or $k eq 'ENVY_LINKBASE');
    $k;
}

sub assign {
    my ($o, $reverse, $k, $force, $v) = @_;
    $k = $o->edit_key($k);
    return if !$k;
    return $o->e("Variable '$k' must be edited with +=")
	if ($k eq 'PATH' or $k eq 'MANPATH');
    if (!$reverse) {
	$o->n("Variable '$k' redefined") if
	    (!$force and exists $o->{env}{$k});
	my $vinterp = $o->interpolate(1,$v);
	$o->{env}{$k} = $vinterp;
	$o->t("$k=$vinterp");
    }
    else {
	delete $o->{env}{$k};
	$o->t("unset $k");
    }
}

sub rejoin {
    my ($o, $reverse, $k, $prepend, $sep, $v) = @_;
    $k = $o->edit_key($k);
    return if !$k;

    # SPECIAL CASES:
    #
    # PATH      - '.' is always kept first if it is seen
    #             @FORCEPATH is always next
    #             don't remove ourselves from the path?
    #             if switching to a new envy.pl abort subsequent loads?
    #
    # ENVY_PATH - rescan all directories for .env files

    # fetch old list
    my @old = split /$sep+/, $o->{env}{$k} if defined $o->{env}{$k};

    # fetch delta
    my @delta = split /$sep+/, $o->interpolate(0,$v);
    my %delta; for (@delta) { $delta{$_}=1 }
    my @now;

    my $sign = $reverse?'-':'+';
    $o->t("$k".($prepend?"$sign=":"=$sign").join($sep, @delta));

    # filter @old with @delta -> @now
    if ($k eq 'PATH') {
	my %old; for (@old) { $old{$_}=1; }
	my $has_dot = exists $old{'.'};
	my %ign; for ('.', @FORCEPATH) { $ign{$_}=1 }

	@now = @delta if $prepend && !$reverse;

	for my $p (@old) {
	    if (!$reverse and exists $delta{$p} and !exists $ign{$p}) {
		$o->n("Component '$p' added to '$k' again");
		next
	    }
	    next if delete $delta{$p} || exists $ign{$p};
	    push @now, $p;
	}

	push @now, @delta if !$prepend && !$reverse;
	unshift @now, @FORCEPATH;
	unshift @now, '.' if $has_dot; # once sloppy always sloppy
    } else {
	push @now, @delta if $prepend && !$reverse;
	for my $p (@old) {
	    if (!$reverse and exists $delta{$p}) {
		$o->n("Component '$p' added to '$k' again");
		next
	    }
	    next if delete $delta{$p};
	    push @now, $p;
	}
	push @now, @delta if !$prepend && !$reverse;
    }
    if (@now) {
	$o->{env}{$k} = join $sep, @now;
    } else {
	delete $o->{env}{$k};
    }
}

# ---------------------------------------------------------------
# PROCESS A SINGLE FILE

sub _inherit_how {
    my $how = shift;
    $how==0? 0 : ($how > 0? 1:-1)
}

sub process_envy { #PRIVATE
    my ($o, $how, $e, $by) = @_;
    confess $o if @_ != 4;
    confess "no transaction" if !$o->{transaction};
    return if $o->{errors} > 5;
    local $Loop = $Loop+1;
    return $o->e("Recursive envy processing detected")
	if $Loop>100;

    $how=1 if $how == 0 && !$o->{loaded}{$e};

    # unload by dimension
    $e = $o->{dimen}{$e} if $how<0 && !$o->{loaded}{$e} && $o->{dimen}{$e};

    local $Path = $o->get_fullpath($e);
    return $o->w("Can't find envy '$e' (skipping)")
	if !$Path;
    if ($how<0 and $o->get_refcnt($e)==0) {
	$o->n("Envy '$e' re-unloaded")
	    if !$o->{unload_all};
	return;
    }

    $o->t("[$how] $e ($Path)");
    my $swap;
    my $mod = !(abs($how)<=1 and ($how>=0 xor $o->get_refcnt($e)==0));
#    warn "$e $how $by mod=$mod\n";
    my @L;
    {
	my $fh = gensym;
	open($fh, $Path) or
	    return $o->w("Envy '$e' (in $Path) is not readable (skipping)");
	@L = <$fh>;  #cache XXX
	close $fh;
    }
    my $seen_stuff=0;
    my $is_first;
    my $prechange = sub {
	return if $seen_stuff;
	$seen_stuff = 1;
	if ($how>0 and $o->is_first and !$o->is_first($e)) {
	    $o->w("Envy '$e' must claim dimension 'First' (don't be shy :-)");
	    $swap = $o->nav_dimension($how, 'First', $e);
	}
	$is_first = $o->is_first($e);
    };
    my $doline = sub {
	my $line = shift;
	my $l = $L[$line-1];

	# need a real lexer; '#' cannot be hidden by quoting! XXX
	# get rid of comment lines & trailing whitespace
	$l =~ s/ \s* (\#.*)? $//sx;
	return if !length $l;

	local $Context = (" at ".($how>=0?'':'un').
			  "envy '$e' line $line\n\t".$Context);
	local $NestLevel = $NestLevel + 1;

	if ($l =~ /^(alpha|beta|deprecated)$/) {
	    $o->w("Envy '$e' is ".uc($1).", use at your own risk")
		if $mod && $how>=0;
	} elsif ($l =~ s/^(echo|error)\s?//) {
	    if ($mod and $how>=0) {
		my $str = $o->interpolate(1,$l)."\n";
		if ($1 eq 'echo') {
		    print $str; # ok? XXX
		} else {
		    $o->e($str);
		}
	    }
	} elsif ($l =~ s/^desc(ription)?\s+//) {
	    # need to reset before reading file XXX
	    # will be backwards for unload XXX
	    # just ignore here? XXX
	    my $d = $o->{desc};
	    if (!$d->{$e}) {
		$d->{$e} = $l;
	    } else {
		$d->{$e} .= "\n$l";
	    }
	} elsif ($l =~ m/^require\s+Envy\s+([\d\.]+)$/) {
	    my $v = $1;
	    return $o->w("Envy '$e' requires envy $v -- this is only $VERSION")
		if $mod && $v > $VERSION;

	} elsif ($l =~ s/^dimension\s+//) {
	    # variable substitution? XXX
	    return $o->w("Dimensions are declared at the beginning (ignored)")
		if $seen_stuff && $how>=0;
	    return $o->w("Bad dimension name '$l' (ignored)")
		if $l !~ m/^[\w-]+$/;
	    $o->n("Dimension '$l' should not mention '$1'")
		if $l =~ m/(release)/ or $l =~ m/(version)/;
	    $swap = $o->nav_dimension($how, $l, $e);

	} elsif ($l =~ s/^require\s+//) {
	    $prechange->();
	    my $str = $o->interpolate(0,$l);
	    return $o->w("Bad characters in require '$str' (skipping)")
		if $str !~ /^[-\w.\/]+$/;
	    $o->process_envy(_inherit_how($how), $str, $e);

	} elsif ($l =~ s/^(c)?sh_load\s+//) {
	    $prechange->();
	    require Envy::Import; # try to avoid in most cases
	    my $envy_file = $o->cache_shell_script($l,$e);
	    if ($envy_file) {
		# reread $HOME/.envy/... XXX
		$o->process_envy(_inherit_how($how), $envy_file, $e);
	    }
	}
	# careful to match PATH=+ before PATH=
	elsif ($l =~ /^([\w-]+) (\+\=|\=\+) (.*)$/x) {
	    my @got = ($1, $2 eq '+=', ':', $3);
	    $prechange->();
	    if ($got[0] eq &PATH) {
		if ($is_first) {
		    $o->w("In First, '".&PATH."' must be assigned with =")
		}
		if ($got[1]) {
		    $o->w("Variable '".&PATH."' cannot be prepended")
		}
		$got[1] = 0;
	    }
	    $o->rejoin($how<0, @got)
		if $mod;
	    $o->search_envy_path if $got[0] eq &PATH;

	} elsif ($l =~ /^([\w-]+) (:)?= (.*)$/x) {
	    my @got = ($1,$2,$3);
	    $prechange->();
	    if (!$is_first and $got[0] eq &PATH) {
		$o->w("Variable '".&PATH."' must be edited with +=")
	    }
	    $o->assign($how<0, @got)
		if $mod;
	    $o->search_envy_path if $got[0] eq &PATH;

	} else {
	    # Newer version of envy knows about new tokens...?
	    $o->n("Inexplicable '$l' (ignored)");
	}
    };

    if ($how>=0) {
	for (my $line_no = 1; $line_no <= @L; $line_no++) {
	    $doline->($line_no);
	    last if $o->{errors} > 5;
	}
	if ($how) {
	    if ($is_first and !$o->{env}{&PATH}) {
		$o->w("You must set '".&PATH."'")
	    }
	    if ($swap and $swap != 1) {
		$o->set_refcnt($e, $swap)
	    } else {
		$o->refcnt_inc($e, $by);
	    }
	}
    } else {
	for (my $line_no = @L; $line_no >= 1; $line_no--) {
	    $doline->($line_no);
	    last if $o->{errors} > 5;
	}
	if ($how < -1) {
	    $o->set_refcnt($e, 0);
	} else {
	    $o->refcnt_dec($e, $by);
	}
    }

    $o->t("[$how] $e DONE");
    $LOGIN ||= getlogin || getpwuid($<) || "?";
    push @{$o->{'log'}}, { when => time(), who => $LOGIN,
			   action => ($how<0?'un':'').'load',
			   what => $e };
}

# ---------------------------------------------------------------
# DURING TRANSACTION

sub envy { #PUBLIC
    my ($o, $reverse, $e) = @_;
    if ($reverse and $o->is_first($e)) {
	$o->unload_all();
    } else {
	my $how = $reverse?-100:100;
	$how=0 if !$reverse && $o->{loaded}{$e};
	$Loop = 0;
	local $Context = " while ".($reverse?"un":"")."loading envy '$e'.\n";
	$o->process_envy($how, $e, '1');
    }
}

sub unload_all { #PUBLIC
    my ($o) = @_;
    $Loop = 0;
    local $Context = " while unloading everything.\n";

    my @un = keys %{$o->{loaded}};
    while (@un) {
	@un = sort { $o->get_seniority($a) <=> $o->get_seniority($b) } @un;
	my $e = shift @un;
	next if !$o->{loaded}{$e};
	$o->process_envy(-100, $e, '1') if !$o->is_first($e);
    }
    # make sure we didn't shoot ourself in the foot
    $o->{unload_all}=1;
    $o->process_envy(-1, $o->{first}, '1');
    $o->process_envy(1, $o->{first}, '1');
    $o->{unload_all}=0;
}

# ---------------------------------------------------------------
# AFTER TRANSACTION COMMIT

sub write_log { #PUBLIC
    my ($o) = @_;
    confess "transaction in progress" if $o->{transaction};
    require FindBin;
    my $file = "$FindBin::Bin/../var/envy.log";
    my @stat = stat($file);
    if (@stat and $stat[7] > 1024 * 256) {
	$o->w("envy: rename $file $file.old: $!\n")
	    if !rename $file, "$file.old";
    }
    my $LOG = gensym;
    sysopen($LOG, $file, &O_WRONLY| &O_APPEND| &O_CREAT, 0666) or
	return $o->n("envy: open $file: $!");
    for my $e (@{$o->{'log'}}) {
	print $LOG (join("\t", scalar localtime($e->{when}),
			 $e->{who}, $o->{where}, $e->{action}, $e->{what})."\n");
    }
}

sub to_sync { #PUBLIC
    my ($o) = @_;
    confess "transaction in progress" if $o->{transaction};
    return if $o->{errors};
    my $delta = $o->{delta};
    sort {$a->[0] cmp $b->[0]} map { [$_,$$delta{$_}] } keys %$delta;
}

# ---------------------------------------------------------------

sub warnings { #PUBLIC
    my ($o) = @_;
    Carp::cluck "use warnlevel instead of warnings(level)"
	if @_ == 2;
    my $all = $o->{'warn'};
    $o->{'warn'} = [];
    @$all;
}

sub description { #PUBLIC
    my($o,$mo) = @_;
    $o->catalogue() if !keys %{$o->{desc}};
    $o->{desc}{$mo};
}

sub status { #PUBLIC
    carp 'status is deprecated';
    my ($o) = @_;
    my @loaded = keys %{$o->{loaded}};
    ($o->get_fullpath(),\@loaded);
}

sub status2 { #PUBLIC
    my ($o) = @_;
    ($o->get_fullpath(),$o->{loaded});
}

sub quick_status { #PUBLIC
    my ($o) = @_;
    ($o->{loaded}, $o->{dimen});
}

sub check_fuzzy {  # move to another file XXX
    my ($o, $mo) = @_;
    $o->w("Envy: non-interactive fuzzy match used to load '$mo'.\n  Please use 'envy load $mo' instead of just 'envy $mo'!\n")
	if $o->{where} ne 'shell';
}

1;

# set_defaults.PL DB.IN -> DB.pm