tie VARIABLE, CLASSNAME, LIST

##</code><code>##

    use Tie::Dir;
    tie %hash, Tie::Dir, "./";

##</code><code>##

    TIEHASH classname, LIST
    DESTROY this
    FETCH this, key
    STORE this, key, value
    DELETE this, key
    EXISTS this, key
    FIRSTKEY this
    NEXTKEY this, lastkey

##</code><code>##

    TIEARRAY classname, LIST
    DESTROY this
    FETCH this, key
    STORE this, key, value

##</code><code>##

    TIEHANDLE classname, LIST
    WRITE this, LIST
    PRINT this, LIST
    PRINTF this, LIST
    READ this, LIST
    READLINE this
    GETC this
    CLOSE this
    DESTROY this

##</code><code>##

    # tie %hash, Tie::Dir, ".", DIR_UNLINK;

    sub TIEHASH {
        my($class,$dir,$unlink) = @_;
        $unlink ||= 0;
        bless [$dir,undef,$unlink], $class;
    }

##</code><code>##

    sub TIESCALAR {
        my $class = shift;
        my $name = shift;
        my $city = system("/bin/cat", "$name\.city");

        return bless \$city, $class;
    }

##</code><code>##

    use Tie::getCity; # If the module name was Tie/getCity.pm

    tie($foo, 'Tie::getCity', $ENV{REMOTE_USER});

##</code><code>##

    untie $foo;

##</code><code>##

    package Example;

    use strict;
    use vars qw($VERSION);

    # pull $VERSION from RCS version identifier
    ($VERSION = substr(q$Revision: 0.7 $, 10)) =~ s/\s+$//;

    sub Version {return $VERSION;}

    use Carp;

##</code><code>##

    # Create tied hash

    sub TIEHASH {
        my $self = shift;
        my $path = shift;
        my $mode = shift || 'r';

        if (@_) {
            croak ("usage: tie(\%hash, \$file, [mode])");
        }

        my $clobber = ($mode eq 'rw' ? 1 : 0);

        my $node = {
            PATH    => $path,
            CLOBBER => $clobber,
            CURRENT => {}
        };

        open(FH, "$path");
        my @lines = <FH>;
        close FH;

        my ($line, $id, $pass);
        foreach $line (@lines) {
            ($id, $pass) = split(/\:/,$line);
            $node->{CURRENT}{$id} = $pass;
        }

        return bless $node => $self;
    }

##</code><code>##

    $hash{FOO} = "bar";

##</code><code>##

    # Store an entry

    sub STORE {
        my $self = shift;
        my ($id) = shift;
        my ($passwd) = shift;
        my ($passwdFile) = $self->{PATH};
        my ($return)=0;
        my (@cache);
        my ($cryptedPass);

        unless ($self->{CLOBBER}) {
            carp ("No write access for $self->{PATH}");
            return;
        }

        if (!$id && !$passwd) {return 1;}
    }

##</code><code>##

    $hash{name} = "";
# or
    $hash{name} = undef;

##</code><code>##

    if ($passwd eq "") {
        $cryptedPass = "";
    } else {
        $cryptedPass = crypt($passwd, $salt);
    }

##</code><code>##

 
    # Warning, possible race condition ahead
    # I need to update this opening a locking!
    if (!open(FH,"<$passwdFile")) {
        carp("Cannot open $passwdFile: $!");
        return;
    }
    flock(FH, 2);

    if (!exists $self->{CURRENT}{Id}) {
        while (<FH>) {
            if ( /^$Id\:/ ) {
                push (@cache, "$Id\:$cryptedPass\n")
                    unless $cryptedPass eq "";
                $return = 1; 
            } else {
                push (@cache, $_);
            }
        }
    }
    close FH;
    
    if ($return) {
        if (!open(FH, ">$passwdFile")) {
            carp("Cannot open $passwdFile: $!");
            return;
        }
        flock(FH, 2);
        while (@cache) { 
            print FH shift (@cache); 
        }
    } else {
        if (!open(FH, ">>$passwdFile")) {
            carp("Cannot open $passwdFile: $!");
            return;
        }
        flock(FH, 2);
        print FH "$Id\:$cryptedPass\n" unless $cryptedPass eq "";
        $foo = $hash{FOO};
    }

##</code><code>##

    sub FETCH {
        my $self = shift;
        my $Id = shift;         
        if (exists $self->{CURRENT}{$Id}) {
            return $self->{CURRENT}{$Id};
        } else {
            return "$Id doesn't exist";
        }
    }

##</code><code>##

    delete $hash{FOO};

##</code><code>##

    sub DELETE {
        my $self = shift;
        my ($Id) = shift;
        my ($passwdFile) = $self->{PATH};
        my (@cache); 

        unless ($self->{CLOBBER}) {
            carp ("No write access for $self->{PATH}");
            return;
        } 

        if (!exists $self->{CURRENT}{$Id}) {return 1;}

        delete $self->{CURRENT}{$Id};

        if (!open(FH,"<$passwdFile")) {
            carp("Cannot open $passwdFile: $!");
            return;
        }
        flock(FH, 2);
        while (<FH>) {
            if ( /^$Id\:/ ) { 
                next;
            } else {
                push (@cache, $_);
            }
        }
        close FH;

        if (!open(FH,">$passwdFile")) {
            carp("Cannot open $passwdFile: $!");
            return;
        }
        flock(FH, 2);
        while (@cache) {
            print FH shift (@cache); 
        }
        close FH;
        return 1;
    }

##</code><code>##

    %hash = "";
    %hash = %newHash;
    %hash = {};
    undef %hash;

##</code><code>##

    sub CLEAR {
        my $self = shift;
        my ($passwdFile) = $self->{PATH};

        unless ($self->{CLOBBER}) {
            carp ("No write access for $self->{PATH}");
            return;
        } 

        if (!open(FH,">$passwdFile")) {
            carp("Cannot open $passwdFile: $!");
            return;
        }
        close FH;
        $self->{CURRENT} = {};
    }

##</code><code>##

    sub FIRSTKEY {
        my $self = shift; 
        my $a = keys %{$self->{CURRENT}};
        each %{$self->{CURRENT}};
    }

##</code><code>##

    sub NEXTKEY {
        my $self = shift;
        return each %{$self->{CURRENT}};

    }

##</code><code>##

    sub DESTROY { unlink "/tmp/tie.txt";}

##</code><code>##

    #!/usr/bin/perl
    use Example;

    tie(%hash, "Example", "example", "rw") || die "Can't tie : $!";

    &ask;

    sub ask {
        print "(A)dd, (D)elete, or (G)et user:";
        $ans = <STDIN>;
        if ($ans =~ /a/i) { &add; }
        elsif ($ans =~ /d/i) { &delete;} 
        elsif ($ans =~ /g/i) {&get;}
        else { print "Try again\n"; &ask;}
    }

    sub add {
        print "User Name:";
        $name = <STDIN>;
        print "\nPassword:";
        $pass = <STDIN>;
        chop $name;
        chop $pass;
        $hash{$name} = $pass;
        print "\nAdded\nAgain (Y/N)?";
        $again = <STDIN>;
        if ($again !~ /y/i) { untie %hash; exit;}else{&ask;}

    }

    sub delete {
        print "User Name:";
        $name = <STDIN>;
        chop $name;
        delete $hash{$name};
        print "\nDeleted\nAgain (Y/N)?";
        $again = <STDIN>;
        if ($again !~ /y/i) { untie %hash; exit;}else{&ask;}

    }

    sub get {
        print "User Name:";
        $name = <STDIN>;
        chop $name;
        if (!exists $hash{$name}) {
            print "$name isn't valid";
        } else {
            print "$name\'s encrypted password is " . $hash{$name};
        }
        print "\nAgain (Y/N)?";
        $again = <STDIN>;
        if ($again !~ /y/i) { untie %hash; exit;}else{&ask;}

    }

##</code><code>##

    tied(%hash)->newPwdFile('/usr/local/apache/.passwds');

##</code><code>##

    $obj = tie(%hash, 'Tie::Class', 'rw');
    $obj->newPwdFile('/usr/local/apache/.passwds');

##</code><code>##

    sub newPwdFile {
        my $self = shift;
        $self->{PATH} = @_ ? shift : die "No new file given";

        unless (-e $self->{PATH}) {
            if ($self->{CLOBBER}) {
                unless (open(FH,">$self->{PATH}")) {
                    croak("Can't create $self->{PATH}: $!");
                }
            } else {
                croak("$self->{PATH} does not exist");
            }
        }
        close FH;

        my ($line, $id, $pass, @lines);
        foreach $line (@lines) {
            ($id, $pass) = split(/\:/,$line);
            $self->{CURRENT}{$id} = $pass;
        }

    }

##</code><code>##

    # Usage: tie($VARIABLE,'TrackScalar', FILE, "\$VARIABLE name/description");

    # use TrackScalar;
    # my $var;
    # tie($var, 'TrackScalar', 'track.txt', "\$var (keeps count)");

    package TrackScalar;

    use strict;
    use vars qw($VERSION @ISA);

    # Get Revision number from RCS
    ($VERSION = substr(q$Revision: 0.2 $, 10)) =~ s/\s+$//;

    sub Version {return $VERSION;}

    use IO::File;

    # Create tied scalar

    sub TIESCALAR {
        my $class = shift;
        my $log = shift;
        my $var = shift || "(undefined)";
        my $fh = new IO::File ">> $log"
            or die "Cannot open $log: $!\n";

        # Notice that the variable being blessed in the object is
        # an anonymous hash, and this is tied to the scalar
        return bless {FH => $fh, VAL => 0, VAR => $var}, $class;
    }

    sub FETCH {
        my $self = shift;
        my ($package, $filename, $line) = caller();
        my $fh = $self->{FH};
        print $fh "package $package, ",
            "$filename line $line FETCHED $self->{VAR}\n";

        return $self->{VAL};
    }

    sub STORE {
        my $self = shift;
        my $var = shift;
        my $fh = $self->{FH};
        my ($package, $filename, $line) = caller();
        print $fh "package $package, ",
            "$filename line $line changed $self->{VAR} to $var\n";
        $self->{VAL} = $var;
    }

    sub DESTROY {
        undef %{$_[0]};
    }

    1;