depot.pm

harvest是一个下载html网页得机器人

    my($self) = shift;
    ($$self[1]) || return FALSE;
    (scalar(@_) == 0) || return FALSE;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldpsync($depot);
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $bool = $depot->optimize($bnum);
# Method: Optimize the database.
# `$bnum' specifies the number of the elements of the bucket array.  If it is undef or not more
# than 0, the default value is specified.
# If successful, the return value is true, else, it is false.
# In an alternating succession of deleting and storing with overwrite or concatenate,
# dispensable regions accumulate.  This method is useful to do away with them.
#
sub optimize {
    my($self) = shift;
    ($$self[1]) || return FALSE;
    my($bnum) = shift;
    (defined($bnum)) || ($bnum = -1);
    (scalar(@_) == 0) || return FALSE;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldpoptimize($depot, $bnum);
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $num = $depot->fsiz();
# Method: Get the size of the database file.
# If successful, the return value is the size of the database file, else, it is -1.
#
sub fsiz {
    my($self) = shift;
    ($$self[1]) || return -1;
    (scalar(@_) == 0) || return -1;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldpfsiz($depot);
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $num = $depot->bnum();
# Method: Get the number of the elements of the bucket array.
# If successful, the return value is the number of the elements of the bucket array, else, it
# is -1.
#
sub bnum {
    my($self) = shift;
    ($$self[1]) || return -1;
    (scalar(@_) == 0) || return -1;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldpbnum($depot);
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $num = $depot->rnum();
# Method: Get the number of the records stored in the database.
# If successful, the return value is the number of the records stored in the database, else,
# it is -1.
#
sub rnum {
    my($self) = shift;
    ($$self[1]) || return -1;
    (scalar(@_) == 0) || return -1;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldprnum($depot);
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $bool = $depot->writable();
# Method: Check whether the database handle is a writer or not.
# The return value is true if the handle is a writer, false if not.
#
sub writable {
    my($self) = shift;
    ($$self[1]) || return FALSE;
    (scalar(@_) == 0) || return FALSE;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldpwritable($depot);
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $bool = $depot->fatalerror();
# Method: Check whether the database has a fatal error or not.
# The return value is true if the database has a fatal error, false if not.
#
sub fatalerror {
    my($self) = shift;
    ($$self[1]) || return FALSE;
    (scalar(@_) == 0) || return FALSE;
    my($depot) = $handles{$$self[0]};
    my($rv) = pldpfatalerror($depot);
    $errmsg = pldperrmsg();
    return $rv;
}


##
#: Called automatically by the garbage collector.
# Destructor: DESTROY: Release the resources.
# If the database handle is not closed yet, it is closed.
#
sub DESTROY {
    my($self) = shift;
    $self->close();
}


##
# $depot = tie(%hash, "Depot", $name, $omode, $bnum);
# Tying Function: TIEHASH: Get the database handle.
#
sub TIEHASH {
    my($class, $name, $omode, $bnum) = @_;
    (defined($name)) || return undef();
    (defined($omode)) || ($omode = OWRITER | OCREAT);
    (defined($bnum)) || ($bnum = -1);
    return $class->new($name, $omode, $bnum);
}


##
# $bool = ($hash{$key} = $val);
# Tying Function: STORE: Store a record with overwrite.
#
sub STORE {
    my($self, $key, $val) = @_;
    ($$self[1]) || return FALSE;
    (defined($key) && defined($val)) || return FALSE;
    my($depot) = $handles{$$self[0]};
    if($$self[2]){
        local($_) = $key;
        $$self[2]();
        $key = $_;
    }
    if($$self[3]){
        local($_) = $val;
        $$self[3]();
        $val = $_;
    }
    my($rv) = pldpput($depot, $key, length($key), $val, length($val), DOVER);
    ($rv == 0) && ($errmsg = pldperrmsg());
    return $rv;
}


##
# $bool = delete($hash{$key});
# Tying Function: DELETE: Delete a record.
#
sub DELETE {
    my($self, $key) = @_;
    ($$self[1]) || return FALSE;
    (defined($key)) || return FALSE;
    my($depot) = $handles{$$self[0]};
    if($$self[2]){
        local($_) = $key;
        $$self[2]();
        $key = $_;
    }
    my($rv) = pldpout($depot, $key, length($key));
    $errmsg = pldperrmsg();
    return $rv;
}


##
# $bool = (%hash = ());
# Tying Function: CLEAR: Delete all records.
#
sub CLEAR {
    my($self) = shift;
    ($self->iterinit()) || return FALSE;
    my($key);
    while(defined($key = $self->iternext())){
        ($self->out($key)) || return FALSE;
    }
    return TRUE;
}


##
# $str = $hash{$key};
# Tying Function: FETCH: Retrieve whole value of a record.
#
sub FETCH {
    my($self, $key) = @_;
    ($$self[1]) || return undef();
    (defined($key)) || return undef();
    my($depot) = $handles{$$self[0]};
    if($$self[2]){
        local($_) = $key;
        $$self[2]();
        $key = $_;
    }
    my($rv) = pldpget($depot, $key, length($key), 0, -1);
    $errmsg = pldperrmsg();
    if($rv && $$self[5]){
        local($_) = $rv;
        $$self[5]();
        $rv = $_;
    }
    return $rv;
}


##
# $bool = exists($hash{$val});
# Tying Function: EXISTS: Check whether a record exists or not.
#
sub EXISTS {
    my($self) = shift;
    my($key) = shift;
    return $self->vsiz($key) >= 0 ? TRUE : FALSE;
}


##
#: Called automatically by keys(), each(), and so on.
# Tying Function: FIRSTKEY: Get the first key.
#
sub FIRSTKEY {
    my($self) = shift;
    ($self->iterinit()) || return undef();
    return $self->iternext();
}


##
#: Called automatically by keys(), each(), and so on.
# Tying Function: NEXTKEY: Get the next key.
#
sub NEXTKEY {
    my($self) = shift;
    return $self->iternext();
}


##
# $func = $depot->filter_store_key(\&nf);
# Method: set a filter invoked when writing a key.
# `\&nf' specifies the reference of a filter function proofing `$_'.  If it is undef, the
# current filter function is cleared.
# The return value is the old filter function.
#
sub filter_store_key {
    my($self) = shift;
    my($nf) = shift;
    my($of) = $$self[2];
    $$self[2] = $nf;
    return $of;
}


##
# $func = $depot->filter_store_value(\&nf);
# Method: set a filter invoked when writing a value.
# `\&nf' specifies the reference of a filter function proofing `$_'.  If it is undef, the
# current filter function is cleared.
# The return value is the old filter function.
#
sub filter_store_value {
    my($self) = shift;
    my($nf) = shift;
    my($of) = $$self[3];
    $$self[3] = $nf;
    return $of;
}


##
# $func = $depot->filter_fetch_key(\&nf);
# Method: set a filter invoked when reading a key.
# `\&nf' specifies the reference of a filter function proofing `$_'.  If it is undef, the
# current filter function is cleared.
# The return value is the old filter function.
#
sub filter_fetch_key {
    my($self) = shift;
    my($nf) = shift;
    my($of) = $$self[4];
    $$self[4] = $nf;
    return $of;
}


##
# $func = $depot->filter_fetch_value(\&nf);
# Method: set a filter invoked when reading a value.
# `\&nf' specifies the reference of a filter function proofing `$_'.  If it is undef, the
# current filter function is cleared.
# The return value is the old filter function.
#
sub filter_fetch_value {
    my($self) = shift;
    my($nf) = shift;
    my($of) = $$self[5];
    $$self[5] = $nf;
    return $of;
}



TRUE;                                    # return success code


# END OF FILE