perltie.pod

MSYS在windows下模拟了一个类unix的终端

    sub DELETE {
      my $self  = shift;
      my $index = shift;
      return $self->STORE( $index, '' );
    }

=item CLEAR this

Clear (remove, delete, ...) all values from the tied array associated with
object I<this>.  For example:

    sub CLEAR {
      my $self = shift;
      return $self->{ARRAY} = [];
    }

=item PUSH this, LIST 

Append elements of I<LIST> to the array.  For example:

    sub PUSH {  
      my $self = shift;
      my @list = @_;
      my $last = $self->FETCHSIZE();
      $self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
      return $self->FETCHSIZE();
    }   

=item POP this

Remove last element of the array and return it.  For example:

    sub POP {
      my $self = shift;
      return pop @{$self->{ARRAY}};
    }

=item SHIFT this

Remove the first element of the array (shifting other elements down)
and return it.  For example:

    sub SHIFT {
      my $self = shift;
      return shift @{$self->{ARRAY}};
    }

=item UNSHIFT this, LIST 

Insert LIST elements at the beginning of the array, moving existing elements
up to make room.  For example:

    sub UNSHIFT {
      my $self = shift;
      my @list = @_;
      my $size = scalar( @list );
      # make room for our list
      @{$self->{ARRAY}}[ $size .. $#{$self->{ARRAY}} + $size ]
       = @{$self->{ARRAY}};
      $self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
    }

=item SPLICE this, offset, length, LIST

Perform the equivalent of C<splice> on the array. 

I<offset> is optional and defaults to zero, negative values count back 
from the end of the array. 

I<length> is optional and defaults to rest of the array.

I<LIST> may be empty.

Returns a list of the original I<length> elements at I<offset>.

In our example, we'll use a little shortcut if there is a I<LIST>:

    sub SPLICE {
      my $self   = shift;
      my $offset = shift || 0;
      my $length = shift || $self->FETCHSIZE() - $offset;
      my @list   = (); 
      if ( @_ ) {
        tie @list, __PACKAGE__, $self->{ELEMSIZE};
        @list   = @_;
      }
      return splice @{$self->{ARRAY}}, $offset, $length, @list;
    }

=item UNTIE this

Will be called when C<untie> happens. (See below.)

=item DESTROY this

This method will be triggered when the tied variable needs to be destructed.
As with the scalar tie class, this is almost never needed in a
language that does its own garbage collection, so this time we'll
just leave it out.

=back

=head2 Tying Hashes

Hashes were the first Perl data type to be tied (see dbmopen()).  A class
implementing a tied hash should define the following methods: TIEHASH is
the constructor.  FETCH and STORE access the key and value pairs.  EXISTS
reports whether a key is present in the hash, and DELETE deletes one.
CLEAR empties the hash by deleting all the key and value pairs.  FIRSTKEY
and NEXTKEY implement the keys() and each() functions to iterate over all
the keys.  UNTIE is called when C<untie> happens, and DESTROY is called when
the tied variable is garbage collected.

If this seems like a lot, then feel free to inherit from merely the
standard Tie::Hash module for most of your methods, redefining only the
interesting ones.  See L<Tie::Hash> for details.

Remember that Perl distinguishes between a key not existing in the hash,
and the key existing in the hash but having a corresponding value of
C<undef>.  The two possibilities can be tested with the C<exists()> and
C<defined()> functions.

Here's an example of a somewhat interesting tied hash class:  it gives you
a hash representing a particular user's dot files.  You index into the hash
with the name of the file (minus the dot) and you get back that dot file's
contents.  For example:

    use DotFiles;
    tie %dot, 'DotFiles';
    if ( $dot{profile} =~ /MANPATH/ ||
         $dot{login}   =~ /MANPATH/ ||
         $dot{cshrc}   =~ /MANPATH/    )
    {
	print "you seem to set your MANPATH\n";
    }

Or here's another sample of using our tied class:

    tie %him, 'DotFiles', 'daemon';
    foreach $f ( keys %him ) {
	printf "daemon dot file %s is size %d\n",
	    $f, length $him{$f};
    }

In our tied hash DotFiles example, we use a regular
hash for the object containing several important
fields, of which only the C<{LIST}> field will be what the
user thinks of as the real hash.

=over 5

=item USER

whose dot files this object represents

=item HOME

where those dot files live

=item CLOBBER

whether we should try to change or remove those dot files

=item LIST

the hash of dot file names and content mappings

=back

Here's the start of F<Dotfiles.pm>:

    package DotFiles;
    use Carp;
    sub whowasi { (caller(1))[3] . '()' }
    my $DEBUG = 0;
    sub debug { $DEBUG = @_ ? shift : 1 }

For our example, we want to be able to emit debugging info to help in tracing
during development.  We keep also one convenience function around
internally to help print out warnings; whowasi() returns the function name
that calls it.

Here are the methods for the DotFiles tied hash.

=over 4

=item TIEHASH classname, LIST

This is the constructor for the class.  That means it is expected to
return a blessed reference through which the new object (probably but not
necessarily an anonymous hash) will be accessed.

Here's the constructor:

    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]
		|| croak "@{[&whowasi]}: no user $user";
	$dir .= "/$dotdir" if $dotdir;

	my $node = {
	    USER    => $user,
	    HOME    => $dir,
	    LIST    => {},
	    CLOBBER => 0,
	};

	opendir(DIR, $dir)
		|| croak "@{[&whowasi]}: can't opendir $dir: $!";
	foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
	    $dot =~ s/^\.//;
	    $node->{LIST}{$dot} = undef;
	}
	closedir DIR;
	return bless $node, $self;
    }

It's probably worth mentioning that if you're going to filetest the
return values out of a readdir, you'd better prepend the directory
in question.  Otherwise, because we didn't chdir() there, it would
have been testing the wrong file.

=item FETCH this, key

This method will be triggered every time an element in the tied hash is
accessed (read).  It takes one argument beyond its self reference: the key
whose value we're trying to fetch.

Here's the fetch for our DotFiles example.

    sub FETCH {
	carp &whowasi if $DEBUG;
	my $self = shift;
	my $dot = shift;
	my $dir = $self->{HOME};
	my $file = "$dir/.$dot";

	unless (exists $self->{LIST}->{$dot} || -f $file) {
	    carp "@{[&whowasi]}: no $dot file" if $DEBUG;
	    return undef;
	}

	if (defined $self->{LIST}->{$dot}) {
	    return $self->{LIST}->{$dot};
	} else {
	    return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
	}
    }

It was easy to write by having it call the Unix cat(1) command, but it
would probably be more portable to open the file manually (and somewhat
more efficient).  Of course, because dot files are a Unixy concept, we're
not that concerned.

=item STORE this, key, value

This method will be triggered every time an element in the tied hash is set
(written).  It takes two arguments beyond its self reference: the index at
which we're trying to store something, and the value we're trying to put
there.

Here in our DotFiles example, we'll be careful not to let
them try to overwrite the file unless they've called the clobber()
method on the original object reference returned by tie().

    sub STORE {
	carp &whowasi if $DEBUG;
	my $self = shift;
	my $dot = shift;
	my $value = shift;
	my $file = $self->{HOME} . "/.$dot";
	my $user = $self->{USER};

	croak "@{[&whowasi]}: $file not clobberable"
	    unless $self->{CLOBBER};

	open(F, "> $file") || croak "can't open $file: $!";
	print F $value;
	close(F);
    }

If they wanted to clobber something, they might say:

    $ob = tie %daemon_dots, 'daemon';
    $ob->clobber(1);
    $daemon_dots{signature} = "A true daemon\n";

Another way to lay hands on a reference to the underlying object is to
use the tied() function, so they might alternately have set clobber
using:

    tie %daemon_dots, 'daemon';
    tied(%daemon_dots)->clobber(1);

The clobber method is simply:

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

=item DELETE this, key

This method is triggered when we remove an element from the hash,
typically by using the delete() function.  Again, we'll
be careful to check whether they really want to clobber files.

    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->{LIST}->{$dot};
	my $success = unlink($file);
	carp "@{[&whowasi]}: can't unlink $file: $!" unless $success;
	$success;
    }

The value returned by DELETE becomes the return value of the call
to delete().  If you want to emulate the normal behavior of delete(),
you should return whatever FETCH would have returned for this key.
In this example, we have chosen instead to return a value which tells
the caller whether the file was successfully deleted.

=item CLEAR this

This method is triggered when the whole hash is to be cleared, usually by
assigning the empty list to it.

In our example, that would remove all the user's dot files!  It's such a
dangerous thing that they'll have to set CLOBBER to something higher than
1 to make it happen.

    sub CLEAR    {
	carp &whowasi if $DEBUG;
	my $self = shift;
	croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}"
	    unless $self->{CLOBBER} > 1;
	my $dot;
	foreach $dot ( keys %{$self->{LIST}}) {
	    $self->DELETE($dot);
	}
    }

=item EXISTS this, key

This method is triggered when the user uses the exists() function
on a particular hash.  In our example, we'll look at the C<{LIST}>
hash element for this:

    sub EXISTS   {
	carp &whowasi if $DEBUG;
	my $self = shift;
	my $dot = shift;