Mailing List Archive

Author: creamyg
Date: 2008-08-03 07:31:22 -0700 (Sun, 03 Aug 2008)
New Revision: 3700

Modified:
trunk/perl/lib/KSx/Remote/SearchClient.pm
trunk/perl/lib/KSx/Remote/SearchServer.pm
trunk/perl/lib/KSx/Search/Filter.pm
trunk/perl/lib/KinoSearch.pm
trunk/perl/t/020-subclassing_obj.t
Log:
Kill off instance_vars hash, init_instance_vars(), ready_get(), ready_set(),
ready_get_set().


Modified: trunk/perl/lib/KSx/Remote/SearchClient.pm
===================================================================
--- trunk/perl/lib/KSx/Remote/SearchClient.pm 2008-08-03 07:30:25 UTC (rev 3699)
+++ trunk/perl/lib/KSx/Remote/SearchClient.pm 2008-08-03 14:31:22 UTC (rev 3700)
@@ -7,15 +7,11 @@
use bytes;
no bytes;

-our %instance_vars = __PACKAGE__->init_instance_vars(
- # params/members
- peer_address => \our %peer_address,
- password => \our %password,
+# Inside-out member vars.
+our %peer_address;
+our %password;
+our %sock;

- # members
- sock => \our %sock,
-);
-
use IO::Socket::INET;

sub new {
@@ -42,6 +38,14 @@
return $self;
}

+sub DESTROY {
+ my $self = shift;
+ delete $peer_address{$$self};
+ delete $password{$$self};
+ delete $sock{$$self};
+ $self->SUPER::DESTROY;
+}
+
=for comment

Make a remote procedure call. For every call that does not close/terminate

Modified: trunk/perl/lib/KSx/Remote/SearchServer.pm
===================================================================
--- trunk/perl/lib/KSx/Remote/SearchServer.pm 2008-08-03 07:30:25 UTC (rev 3699)
+++ trunk/perl/lib/KSx/Remote/SearchServer.pm 2008-08-03 14:31:22 UTC (rev 3700)
@@ -7,16 +7,12 @@
use bytes;
no bytes;

-our %instance_vars = __PACKAGE__->init_instance_vars(
- # params / members
- searchable => \our %searchable,
- port => \our %port,
- password => \our %password,
+# Inside-out member vars.
+our %searchable;
+our %port;
+our %password;
+our %sock;

- # members
- sock => \our %sock,
-);
-
use IO::Socket::INET;
use IO::Select;

@@ -46,6 +42,15 @@
return $self;
}

+sub DESTROY {
+ my $self = shift;
+ delete $searchable{$$self};
+ delete $port{$$self};
+ delete $password{$$self};
+ delete $sock{$$self};
+ $self->SUPER::DESTROY;
+}
+
my %dispatch = (
max_docs => \&do_max_docs,
doc_freq => \&do_doc_freq,

Modified: trunk/perl/lib/KSx/Search/Filter.pm
===================================================================
--- trunk/perl/lib/KSx/Search/Filter.pm 2008-08-03 07:30:25 UTC (rev 3699)
+++ trunk/perl/lib/KSx/Search/Filter.pm 2008-08-03 14:31:22 UTC (rev 3700)
@@ -5,11 +5,9 @@
use KinoSearch::Util::ToolSet qw( confess a_isa_b nfreeze thaw weaken );
BEGIN { our @ISA = qw( KinoSearch::Search::Query ) }

-our %instance_vars = __PACKAGE__->init_instance_vars(
- # members
- query => \our %query,
- cached_bits => \our %cached_bits,
-);
+# Inside-out member vars.
+our %query;
+our %cached_bits;

sub new {
my ( $either, %args ) = @_;
@@ -23,6 +21,13 @@
return $self;
}

+sub DESTROY {
+ my $self = shift;
+ delete $query{$$self};
+ delete $cached_bits{$$self};
+ $self->SUPER::DESTROY;
+}
+
sub make_compiler {
my $self = shift;
return KSx::Search::FilterCompiler->new( @_, parent => $self );

Modified: trunk/perl/lib/KinoSearch.pm
===================================================================
--- trunk/perl/lib/KinoSearch.pm 2008-08-03 07:30:25 UTC (rev 3699)
+++ trunk/perl/lib/KinoSearch.pm 2008-08-03 14:31:22 UTC (rev 3700)
@@ -141,10 +141,8 @@
{
package KinoSearch::Analysis::Tokenizer;

- our %instance_vars = __PACKAGE__->init_instance_vars(
- # params/members
- token_re => \our %token_re,
- );
+ # Inside-out member var.
+ our %token_re;

sub new {
my ( $either, %args ) = @_;
@@ -157,6 +155,12 @@
return $self;
}

+ sub DESTROY {
+ my $self = shift;
+ delete $token_re{$$self};
+ $self->SUPER::DESTROY;
+ }
+
sub _cache_token_re {
my ( $self, $token_re ) = @_;
$token_re{$$self} = $token_re || qr/\w+(?:'\w+)*/;
@@ -273,117 +277,8 @@
package KinoSearch::Obj;
use KinoSearch::Util::ToolSet qw( confess reftype to_perl );

- my %vars_hashes;
-
- sub dump {
- my $self = shift;
- my $all_vars = _sync_vars_hash( ref($self) );
- my %values = map { ( $_, $all_vars->{$_}{$$self} ) }
- grep { defined $all_vars->{$_} } keys %$all_vars;
- kdump( { $self => \%values } );
- }
-
sub _to_string {"$_[0]"}

- sub _sync_vars_hash {
- my $class = shift;
- my %all_vars;
- _all_vars( $class, \%all_vars );
- $vars_hashes{$class} = \%all_vars;
- return \%all_vars;
- }
-
- sub _all_vars {
- my ( $package, $all_vars ) = @_;
- my $instance_vars = _retrieve_hashref("$package\::instance_vars");
- if ( defined $instance_vars ) {
- while ( my ( $k, $v ) = each %$instance_vars ) {
- confess("duplicate field: '$k'") if exists $all_vars->{$k};
- $all_vars->{$k} = $v;
- }
- }
-
- no strict 'refs';
- for my $parent ( @{"$package\::ISA"} ) {
- _all_vars( $parent, $all_vars );
- }
- }
-
- sub init_instance_vars {
- my $package = shift;
- die "invalid package: '$package'"
- unless $package =~ /^\w+(?:::\w+)*$/; # "healthy" paranoia
-
- # Install a DESTROY method if one does not already exist.
- no strict 'refs';
- my $destroy_glob = ${"$package\::"}{DESTROY};
- if ( !$destroy_glob or !*$destroy_glob{CODE} ) {
- my $nuke_glob = ${"$package\::"}{NUKE};
- my $has_nuke = ( $nuke_glob and *$nuke_glob{CODE} );
- my $call_nuke = $has_nuke ? 'NUKE($self);' : '';
- my @field_hashes;
- for ( my $i = 1; $i < @_; $i += 2 ) {
- my $hashref = $_[$i];
- next unless defined $hashref;
- next unless reftype($hashref) eq 'HASH';
- push @field_hashes, $hashref;
- }
-
- # Only install DESTROY if there's something to DESTROY in
- # Perl-space -- otherwise, just let class inherit DESTROY to
- # handle C-space cleanup.
- if ( $has_nuke or scalar @field_hashes ) {
- eval qq|
- package $package;
- *DESTROY = sub {
- my \$self = CORE::shift;
- $call_nuke
- CORE::delete \$_->{\$\$self} for \@field_hashes;
- \$self->SUPER::DESTROY;
- };
- |;
- die $@ if $@;
- }
- }
-
- return @_;
- }
-
- sub ready_get_set {
- ready_get(@_);
- ready_set(@_);
- }
-
- sub ready_get {
- my $package = shift;
- no strict 'refs';
- for my $var (@_) {
- my $code = qq|
- *{ "$package\::get_$var" } = sub {
- my \$self = shift;
- return \$${package}::$var\{ \$\$self };
- };
- |;
- eval $code;
- die $@ if $@;
- }
- }
-
- sub ready_set {
- my $package = shift;
- no strict 'refs';
- for my $var (@_) {
- my $code = qq|
- *{ "$package\::set_$var" } = sub {
- my \$self = shift;
- \$${package}::$var\{ \$\$self } = shift ;
- };
- |;
- eval $code;
- die $@ if $@;
- }
- }
-
sub abstract_death {
my ( undef, $filename, $line, $methodname ) = caller(1);
die "ERROR: $methodname', called at $filename line $line, is an "
@@ -399,20 +294,6 @@
}

{
- package KinoSearch::Obj::FastObj;
- use KinoSearch::Util::ToolSet qw( confess );
-
- sub init_instance_vars {
- confess "Can't use inside-out pattern with FastObj";
- }
- sub ready_get_set { confess "Can't use inside-out pattern with FastObj" }
- sub ready_get { confess "Can't use inside-out pattern with FastObj" }
- sub ready_set { confess "Can't use inside-out pattern with FastObj" }
-
- sub dump { kdump(shift) }
-}
-
-{
package KinoSearch::Index::DocReader;

use KinoSearch::Util::StringHelper qw( utf8_flag_on );

Modified: trunk/perl/t/020-subclassing_obj.t
===================================================================
--- trunk/perl/t/020-subclassing_obj.t 2008-08-03 07:30:25 UTC (rev 3699)
+++ trunk/perl/t/020-subclassing_obj.t 2008-08-03 14:31:22 UTC (rev 3700)
@@ -4,12 +4,6 @@
package Foo;
use base qw( KinoSearch::Obj );
{
- our %instance_vars = __PACKAGE__->init_instance_vars(
- # members
- thing => \our %thing,
- );
- __PACKAGE__->ready_get_set(qw( thing ));
-
sub to_string {"twine"}

sub die_an_abstract_death { shift->abstract_death }
@@ -43,7 +37,7 @@
}

package main;
-use Test::More tests => 11;
+use Test::More tests => 10;
use Storable qw( freeze thaw );

ok( defined $Foo::version,
@@ -63,9 +57,6 @@
$foo->dec_refcount;
is( $foo->get_refcount, 1, "dec_refcount" );

-$foo->set_thing("bonk");
-is( $foo->get_thing, "bonk", "ready_set, ready_get" );
-
is( $foo->to_string, Foo::to_string(), "override to_string" );

eval { $foo->die_an_abstract_death };


_______________________________________________
kinosearch-commits mailing list
kinosearch-commits@rectangular.com
http://www.rectangular.com/mailman/listinfo/kinosearch-commits