# print out B-news history file offsets

use NDBM_File;

tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);

while (($key,$val) = each %HIST) {

    print $key, ' = ', unpack('L',$val), "\n";

}

untie(%HIST);

*****

use DotFiles;

tie %dot, "DotFiles";

if ( $dot{profile} =~ /MANPATH/ or

     $dot{login}   =~ /MANPATH/ or

     $dot{cshrc}   =~ /MANPATH/    )

{

    print "you've set your manpath\n";

}

*****

# third argument is name of user whose dot files we will tie to

tie %him, 'DotFiles', 'daemon';

foreach $f ( keys %him ) {

    printf "daemon dot file %s is size %d\n",

        $f, length $him{$f};

}

*****

package DotFiles;

use Carp;

sub whowasi { (caller(1))[3] . '()' }

my $DEBUG = 0;

sub debug { $DEBUG = @_ ? shift : 1 }

*****

sub TIEHASH {

    my $self = shift;

    my $user = shift || $>;

    my $dotdir = shift || '';



    croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;



    $user = getpwuid($user) if $user =~ /^\d+$/;

    my $dir = (getpwnam($user))[7]

            or croak "@{[&whowasi]}: no user $user";

    $dir .= "/$dotdir" if $dotdir;



    my $node = {

        USER        => $user,

        HOME        => $dir,

        CONTENTS    => {},

        CLOBBER     => 0,

    };



    opendir DIR, $dir

            or croak "@{[&whowasi]}: can't opendir $dir: $!";

    foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {

        $dot =~ s/^\.//;

        $node->{CONTENTS}{$dot} = undef;

    }

    closedir DIR;



    return bless $node, $self;

}

*****

sub FETCH {

    carp &whowasi if $DEBUG;

    my $self = shift;

    my $dot = shift;

    my $dir = $self->{HOME};

    my $file = "$dir/.$dot";



    unless (exists $self->{CONTENTS}->{$dot} || -f $file) {

        carp "@{[&whowasi]}: no $dot file" if $DEBUG;

        return undef;

    }



    # Implement a cache.

    if (defined $self->{CONTENTS}->{$dot}) {

        return $self->{CONTENTS}->{$dot};

    } else {

        return $self->{CONTENTS}->{$dot} = `cat $dir/.$dot`;

    }

}

*****

sub STORE {

    carp &whowasi if $DEBUG;

    my $self = shift;

    my $dot = shift;

    my $value = shift;

    my $file = $self->{HOME} . "/.$dot";



    croak "@{[&whowasi]}: $file not clobberable"

        unless $self->{CLOBBER};



    open(F, "> $file") or croak "can't open $file: $!";

    print F $value;

    close(F);

}

*****

$ob = tie %daemon_dots, 'daemon';

$ob->clobber(1);

$daemon_dots{signature} = "A true daemon\n";

*****

tie %daemon_dots, 'daemon';

tied(%daemon_dots)->clobber(1);

*****

sub clobber {

    my $self = shift;

    $self->{CLOBBER} = @_ ? shift : 1;

}

*****

sub DELETE   {

    carp &whowasi if $DEBUG;



    my $self = shift;

    my $dot = shift;

    my $file = $self->{HOME} . "/.$dot";

    croak "@{[&whowasi]}: won't remove file $file"

        unless $self->{CLOBBER};

    delete $self->{CONTENTS}->{$dot};

    unlink $file or carp "@{[&whowasi]}: can't unlink $file: $!";

}

*****

sub CLEAR {

    carp &whowasi if $DEBUG;

    my $self = shift;

    croak "@{[&whowasi]}: won't remove all dotfiles for $self->{USER}"

        unless $self->{CLOBBER} > 1;

    my $dot;

    foreach $dot ( keys %{$self->{CONTENTS}}) {

        $self->DELETE($dot);

    }

}

*****

sub EXISTS   {

    carp &whowasi if $DEBUG;

    my $self = shift;

    my $dot = shift;

    return exists $self->{CONTENTS}->{$dot};

}

*****

sub FIRSTKEY {

    carp &whowasi if $DEBUG;

    my $self = shift;

    my $a    = keys %{$self->{CONTENTS}};

    return scalar each %{$self->{CONTENTS}};

}

*****

sub NEXTKEY  {

    carp &whowasi if $DEBUG;

    my $self = shift;

    return scalar each %{ $self->{CONTENTS} }

}

*****

sub DESTROY  {

    carp &whowasi if $DEBUG;

}

