Mailing List Archive

Author: creamyg
Date: 2008-07-27 14:53:36 -0700 (Sun, 27 Jul 2008)
New Revision: 3641

Removed:
trunk/perl/lib/KinoSearch/Store/ViewFileDes.pm
Modified:
trunk/perl/MANIFEST
trunk/perl/lib/KinoSearch.pm
trunk/perl/lib/KinoSearch/Obj.pm
trunk/perl/lib/KinoSearch/Obj/FastObj.pm
trunk/perl/lib/KinoSearch/Store/InStream.pm
trunk/perl/lib/KinoSearch/Store/OutStream.pm
trunk/perl/lib/KinoSearch/Store/RAMFileDes.pm
trunk/perl/lib/KinoSearch/Util/BitVector.pm
trunk/perl/lib/KinoSearch/Util/ByteBuf.pm
trunk/perl/lib/KinoSearch/Util/CharBuf.pm
trunk/perl/lib/KinoSearch/Util/Compat/DirManip.pm
trunk/perl/lib/KinoSearch/Util/DynVirtualTable.pm
trunk/perl/lib/KinoSearch/Util/Hash.pm
trunk/perl/lib/KinoSearch/Util/IntMap.pm
trunk/perl/lib/KinoSearch/Util/Json.pm
trunk/perl/lib/KinoSearch/Util/MathUtils.pm
trunk/perl/lib/KinoSearch/Util/MemoryPool.pm
trunk/perl/lib/KinoSearch/Util/Native.pm
trunk/perl/lib/KinoSearch/Util/Num.pm
trunk/perl/lib/KinoSearch/Util/PriorityQueue.pm
trunk/perl/lib/KinoSearch/Util/SortExRun.pm
trunk/perl/lib/KinoSearch/Util/SortExternal.pm
trunk/perl/lib/KinoSearch/Util/Stepper.pm
trunk/perl/lib/KinoSearch/Util/ToolSet.pm
trunk/perl/lib/KinoSearch/Util/VArray.pm
trunk/perl/lib/KinoSearch/Util/VirtualTable.pm
Log:
Inline perl module code from several common modules from KS::Store and
KS::Util into KinoSearch.pm.


Modified: trunk/perl/MANIFEST
===================================================================
--- trunk/perl/MANIFEST 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/MANIFEST 2008-07-27 21:53:36 UTC (rev 3641)
@@ -177,7 +177,6 @@
lib/KinoSearch/Store/RAMFileDes.pm
lib/KinoSearch/Store/RAMFolder.pm
lib/KinoSearch/Store/SharedLock.pm
-lib/KinoSearch/Store/ViewFileDes.pm
lib/KinoSearch/Test/TestQueryParser.pm
lib/KinoSearch/Test/TestQueryParserLogic.pm
lib/KinoSearch/Test/TestQueryParserSyntax.pm

Modified: trunk/perl/lib/KinoSearch/Obj/FastObj.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Obj/FastObj.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Obj/FastObj.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,17 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Obj::FastObj );

-package KinoSearch::Obj::FastObj;
-use KinoSearch::Util::ToolSet qw( confess );
-use KinoSearch::base qw( KinoSearch::Obj );
-
-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) }
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Obj.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Obj.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Obj.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,154 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Obj KinoSearch::Obj::Undefined );

-package KinoSearch::Obj;
-use KinoSearch::Util::ToolSet qw( confess reftype to_perl );
-
-# Load a bunch of classes which are needed for anything non-trivial. We load
-# them with "require" because they are subclasses of Obj and need access to
-# e.g. init_instance_vars().
-require KinoSearch::Util::ByteBuf;
-require KinoSearch::Util::VArray;
-require KinoSearch::Util::Hash;
-require KinoSearch::Util::Num;
-require KinoSearch::Util::IntMap;
-require KinoSearch::Util::BitVector;
-require KinoSearch::Util::PriorityQueue;
-require KinoSearch::Util::VirtualTable;
-require KinoSearch::Util::DynVirtualTable;
-require KinoSearch::Util::MemoryPool;
-require KinoSearch::Util::Stepper;
-require KinoSearch::Store::InStream;
-require KinoSearch::Store::OutStream;
-require KinoSearch::Store::RAMFileDes;
-require KinoSearch::Store::ViewFileDes;
-
-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 "
- . "abstract method and must be defined in a subclass";
-}
-
-sub todo_death {
- my ( undef, $filename, $line, $methodname ) = caller(1);
- die "ERROR: $methodname, called at $filename line $line, is not "
- . "implemented yet in KinoSearch, but is on the todo list";
-}
-
-package KinoSearch::Obj::Undefined;
-use KinoSearch::base qw( KinoSearch::Obj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Store/InStream.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Store/InStream.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Store/InStream.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,12 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Store::InStream );

-package KinoSearch::Store::InStream;
-use KinoSearch::base qw( KinoSearch::Obj );
-
-use KinoSearch::Store::FSFileDes;
-use KinoSearch::Store::RAMFileDes;
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Store/OutStream.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Store/OutStream.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Store/OutStream.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Store::OutStream );

-package KinoSearch::Store::OutStream;
-use KinoSearch::base qw( KinoSearch::Obj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Store/RAMFileDes.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Store/RAMFileDes.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Store/RAMFileDes.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,13 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Store::RAMFileDes );

-package KinoSearch::Store::RAMFileDes;
-use KinoSearch::base qw( KinoSearch::Store::FileDes );
-
-use KinoSearch::Util::ByteBuf;
-
-sub contents { shift->_contents->to_perl }
-
1;

__END__

Deleted: trunk/perl/lib/KinoSearch/Store/ViewFileDes.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Store/ViewFileDes.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Store/ViewFileDes.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,17 +0,0 @@
-use strict;
-use warnings;
-
-package KinoSearch::Store::ViewFileDes;
-use KinoSearch::base qw( KinoSearch::Store::RAMFileDes );
-
-1;
-
-__END__
-
-__COPYRIGHT__
-
-Copyright 2005-2008 Marvin Humphrey
-
-This program is free software; you can redistribute it and/or modify
-under the same terms as Perl itself.
-

Modified: trunk/perl/lib/KinoSearch/Util/BitVector.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/BitVector.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/BitVector.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,11 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::BitVector );

-package KinoSearch::Util::BitVector;
-use KinoSearch::base qw( KinoSearch::Obj );
-
-sub to_arrayref { shift->to_array->to_arrayref }
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/ByteBuf.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/ByteBuf.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/ByteBuf.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,17 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::ByteBuf KinoSearch::Util::ViewByteBuf );

-package KinoSearch::Util::ByteBuf;
-use KinoSearch::base qw( KinoSearch::Obj::FastObj Exporter );
-
-our @EXPORT_OK = qw( bb_compare bb_less_than ); # testing only
-
-package KinoSearch::Util::ViewByteBuf;
-use KinoSearch::Util::ToolSet qw( confess );
-use KinoSearch::base qw( KinoSearch::Util::ByteBuf );
-
-sub new { confess "ViewByteBuf objects can only be created from C." }
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/CharBuf.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/CharBuf.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/CharBuf.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,37 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::CharBuf );

-package KinoSearch::Util::CharBuf;
-use KinoSearch::base qw( KinoSearch::Obj::FastObj Exporter );
-our @EXPORT_OK = qw( cb_compare );
-
-{
- # Defeat an obscure bug in the XS auto-generation by redefining clone().
- # (Because of how the typemap works for CharBuf*, the auto-generated
- # clone() method returns a UTF-8 Perl scalar rather than an actual CharBuf
- # object.)
- no warnings 'redefine';
-
- sub clone {
- my $self = shift;
- return $self->new( $self->to_string );
- }
-}
-
-package KinoSearch::Util::ViewCharBuf;
-use KinoSearch::Util::ToolSet qw( confess );
-use KinoSearch::base qw( KinoSearch::Util::CharBuf );
-
-sub new { confess "ViewCharBuf has no public constructor." }
-
-package KinoSearch::Util::ZombieCharBuf;
-use KinoSearch::Util::ToolSet qw( confess );
-BEGIN { our @ISA = qw( KinoSearch::Util::ViewCharBuf ); }
-
-sub new { confess "ZombieCharBuf objects can only be created from C." }
-
-sub DESTROY { }
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Compat/DirManip.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Compat/DirManip.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/Compat/DirManip.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,21 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::Compat::DirManip );

-package KinoSearch::Util::Compat::DirManip;
-use KinoSearch::Util::ToolSet qw( confess to_kino );
-use KinoSearch::base qw( KinoSearch::Obj );
-use File::Spec::Functions qw( rel2abs no_upwards );
-
-sub absolutify { return rel2abs( $_[1] ) }
-
-sub list_files {
- my $dir_path = $_[1]->to_perl;
- opendir( my $dir_handle, $dir_path )
- or confess "Can't opendir '$dir_path': $!";
- my @files = no_upwards( readdir $dir_handle );
- return to_kino( \@files );
-}
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/DynVirtualTable.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/DynVirtualTable.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/DynVirtualTable.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,43 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::DynVirtualTable );

-package KinoSearch::Util::DynVirtualTable;
-use KinoSearch::base qw( KinoSearch::Util::VirtualTable );
-
-sub find_parent_vtable {
- my ( $ignore, $package ) = @_;
- return _find_parent_vtable($package);
-}
-
-# Depth-first recursive search of @ISA.
-sub _find_parent_vtable {
- my $package = shift;
- my $registry = _get_registry();
- my $vtable;
- no strict 'refs';
- for my $parent ( @{"$package\::ISA"} ) {
- $vtable = $registry->fetch($parent);
- last if defined $vtable;
- $vtable = _find_parent_vtable($parent);
- last if defined $vtable;
- }
- return $vtable;
-}
-
-sub novel_native_methods {
- my ( undef, $package ) = @_;
- no strict 'refs';
- my $stash = \%{"$package\::"};
- my $methods
- = KinoSearch::Util::VArray->new( capacity => scalar keys %$stash );
- while ( my ( $symbol, $glob ) = each %$stash ) {
- next if ref $glob;
- next unless *$glob{CODE};
- $methods->push( KinoSearch::Util::CharBuf->new($symbol) );
- }
- return $methods;
-}
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Hash.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Hash.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/Hash.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::Hash );

-package KinoSearch::Util::Hash;
-use KinoSearch::base qw( KinoSearch::Obj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/IntMap.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/IntMap.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/IntMap.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,11 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::IntMap );

-package KinoSearch::Util::IntMap;
-use KinoSearch::base qw( KinoSearch::Obj );
-
-our %new_PARAMS = ( ints => undef );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Json.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Json.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/Json.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,45 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::Json );

-package KinoSearch::Util::Json;
-use KinoSearch::base qw( Exporter );
-use KinoSearch::Util::ToolSet qw( to_perl to_kino );
-
-BEGIN {
- our @EXPORT_OK = qw(
- to_json
- from_json
- );
-}
-
-use JSON::XS qw();
-
-my $json_encoder = JSON::XS->new->pretty(1)->canonical(1);
-
-sub to_json { return $json_encoder->encode(shift) }
-sub from_json { return $json_encoder->decode(shift) }
-
-sub slurp_json {
- shift; # useless callback obj
- my %args = @_;
- my $instream = $args{folder}->open_instream( $args{filename} );
- my $len = $instream->length;
- my $json;
- $instream->read_bytes( $json, $len );
- return to_kino( $json_encoder->decode($json) );
-}
-
-sub spew_json {
- shift; # useless callback obj
- my %args = @_;
- my $perl_data = to_perl( $args{obj} );
- my $json = $json_encoder->encode($perl_data);
- my $outstream = $args{folder}->open_outstream( $args{filename} );
- $outstream->print($json);
- $outstream->close;
- return;
-}
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/MathUtils.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/MathUtils.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/MathUtils.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,13 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::MathUtils );

-package KinoSearch::Util::MathUtils;
-use KinoSearch::base qw( Exporter );
-
-our @EXPORT_OK = qw(
- fibonacci
-);
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/MemoryPool.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/MemoryPool.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/MemoryPool.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::MemoryPool );

-package KinoSearch::Util::MemoryPool;
-use KinoSearch::base qw( KinoSearch::Obj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Native.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Native.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/Native.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -4,11 +4,6 @@
package KinoSearch::Util::Native;
use KinoSearch::base qw( KinoSearch::Obj Exporter );

-use KinoSearch::Util::Hash;
-use KinoSearch::Util::ByteBuf;
-use KinoSearch::Util::CharBuf;
-use KinoSearch::Util::VArray;
-
sub _test { return scalar @_ }

sub _test_obj {

Modified: trunk/perl/lib/KinoSearch/Util/Num.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Num.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/Num.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::Num );

-package KinoSearch::Util::Num;
-use KinoSearch::base qw( KinoSearch::Obj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/PriorityQueue.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/PriorityQueue.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/PriorityQueue.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,12 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::PriorityQueue );

-package KinoSearch::Util::PriorityQueue;
-use KinoSearch::Util::ToolSet qw( to_perl );
-use KinoSearch::base qw( KinoSearch::Obj );
-
-sub pop_all { to_perl( shift->_pop_all ) }
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/SortExRun.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/SortExRun.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/SortExRun.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::SortExRun );

-package KinoSearch::Util::SortExRun;
-use KinoSearch::base qw( KinoSearch::Obj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/SortExternal.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/SortExternal.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/SortExternal.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,11 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::SortExternal );

-package KinoSearch::Util::SortExternal;
-use KinoSearch::base qw( KinoSearch::Obj::FastObj );
-
-use KinoSearch::Util::SortExRun;
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Stepper.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Stepper.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/Stepper.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::Stepper );

-package KinoSearch::Util::Stepper;
-use KinoSearch::base qw( KinoSearch::Obj::FastObj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/ToolSet.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/ToolSet.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/ToolSet.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -22,7 +22,6 @@
looks_like_number
);
use Storable qw( nfreeze thaw );
-use KinoSearch qw( kdump );

our @EXPORT_OK = qw(
carp
@@ -44,8 +43,6 @@
nfreeze
thaw

- kdump
-
to_kino
to_perl
verify_args
@@ -184,7 +181,6 @@
isvstring
looks_like_number
);
- use KinoSearch qw( kdump );
use KinoSearch::Util::MathUtils qw( ceil );

Two issues deserve special attention.

Modified: trunk/perl/lib/KinoSearch/Util/VArray.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/VArray.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/VArray.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::VArray );

-package KinoSearch::Util::VArray;
-use KinoSearch::base qw( KinoSearch::Obj::FastObj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/VirtualTable.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/VirtualTable.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch/Util/VirtualTable.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -1,9 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch qw( KinoSearch::Util::VirtualTable );

-package KinoSearch::Util::VirtualTable;
-use KinoSearch::base qw( KinoSearch::Obj::FastObj );
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch.pm
===================================================================
--- trunk/perl/lib/KinoSearch.pm 2008-07-27 21:22:00 UTC (rev 3640)
+++ trunk/perl/lib/KinoSearch.pm 2008-07-27 21:53:36 UTC (rev 3641)
@@ -13,8 +13,6 @@
BEGIN { XSLoader::load( 'KinoSearch', '0.20_06' ) }

use KinoSearch::Autobinding;
-use KinoSearch::base qw( Exporter );
-our @EXPORT_OK = qw( kdump );

sub kdump {
require Data::Dumper;
@@ -24,6 +22,390 @@
warn $kdumper->Dump;
}

+our %exportables = ( kdump => 1, );
+
+# All of these modules are implemented fully by KinoSearch.xs and
+# KinoSearch.pm.
+#
+# To cut down on load time we don't bother to find their
+# empty .pm files if they are loaded via this syntax:
+#
+# use KinoSearch qw(
+# KinoSearch::Util:CharBuf
+# KinoSearch::Util::Hash
+# ...
+# );
+#
+our %inlined = (
+ 'KinoSearch::Obj' => 1,
+ 'KinoSearch::Obj::FastObj' => 1,
+ 'KinoSearch::Obj::Undefined' => 1,
+ 'KinoSearch::Store::InStream' => 1,
+ 'KinoSearch::Store::OutStream' => 1,
+ 'KinoSearch::Store::RAMFileDes' => 1,
+ 'KinoSearch::Store::ViewFileDes' => 1,
+ 'KinoSearch::Util::BitVector' => 1,
+ 'KinoSearch::Util::ByteBuf' => 1,
+ 'KinoSearch::Util::CharBuf' => 1,
+ 'KinoSearch::Util::Compat::DirManip' => 1,
+ 'KinoSearch::Util::ViewCharBuf' => 1,
+ 'KinoSearch::Util::ZombieCharBuf' => 1,
+ 'KinoSearch::Util::DynVirtualTable' => 1,
+ 'KinoSearch::Util::Hash' => 1,
+ 'KinoSearch::Util::IntMap' => 1,
+ 'KinoSearch::Util::Json' => 1,
+ 'KinoSearch::Util::MathUtils' => 1,
+ 'KinoSearch::Util::MemoryPool' => 1,
+ 'KinoSearch::Util::Num' => 1,
+ 'KinoSearch::Util::PriorityQueue' => 1,
+ 'KinoSearch::Util::SortExRun' => 1,
+ 'KinoSearch::Util::SortExternal' => 1,
+ 'KinoSearch::Util::Stepper' => 1,
+ 'KinoSearch::Util::VArray' => 1,
+ 'KinoSearch::Util::VirtualTable' => 1,
+);
+
+sub import {
+ my $class = shift;
+ my $inheritor = caller(0);
+
+ for my $arg (@_) {
+ if ( $inlined{$arg} ) {
+ # Do nothing, because the module's code is fully loaded already.
+ }
+ elsif ( $exportables{$arg} ) {
+ no strict 'refs';
+ *{"$inheritor\::$arg"} = *{ __PACKAGE__ . "::$arg" };
+ }
+ }
+}
+
+{
+ 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 "
+ . "abstract method and must be defined in a subclass";
+ }
+
+ sub todo_death {
+ my ( undef, $filename, $line, $methodname ) = caller(1);
+ die "ERROR: $methodname, called at $filename line $line, is not "
+ . "implemented yet in KinoSearch, but is on the todo list";
+ }
+
+}
+
+{
+ package KinoSearch::Obj::FastObj;
+ use KinoSearch::Util::ToolSet qw( confess );
+ use KinoSearch::base qw( KinoSearch::Obj );
+
+ 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::Store::RAMFileDes;
+ use KinoSearch::base qw( KinoSearch::Store::FileDes );
+
+ sub contents { shift->_contents->to_perl }
+}
+
+{
+ package KinoSearch::Util::BitVector;
+ use KinoSearch::base qw( KinoSearch::Obj );
+
+ sub to_arrayref { shift->to_array->to_arrayref }
+}
+
+{
+ package KinoSearch::Util::ByteBuf;
+ use KinoSearch::base qw( KinoSearch::Obj::FastObj Exporter );
+
+ our @EXPORT_OK = qw( bb_compare bb_less_than ); # testing only
+
+ package KinoSearch::Util::ViewByteBuf;
+ use KinoSearch::Util::ToolSet qw( confess );
+ use KinoSearch::base qw( KinoSearch::Util::ByteBuf );
+
+ sub new { confess "ViewByteBuf objects can only be created from C." }
+}
+
+{
+ package KinoSearch::Util::CharBuf;
+ use KinoSearch::base qw( KinoSearch::Obj::FastObj Exporter );
+ our @EXPORT_OK = qw( cb_compare );
+
+ {
+ # Defeat an obscure bug in the XS auto-generation by redefining
+ # clone(). (Because of how the typemap works for CharBuf*, the
+ # auto-generated clone() method returns a UTF-8 Perl scalar rather
+ # than an actual CharBuf object.)
+ no warnings 'redefine';
+
+ sub clone {
+ my $self = shift;
+ return $self->new( $self->to_string );
+ }
+ }
+}
+
+{
+ package KinoSearch::Util::ViewCharBuf;
+ use KinoSearch::Util::ToolSet qw( confess );
+ use KinoSearch::base qw( KinoSearch::Util::CharBuf );
+
+ sub new { confess "ViewCharBuf has no public constructor." }
+}
+
+{
+ package KinoSearch::Util::ZombieCharBuf;
+ use KinoSearch::Util::ToolSet qw( confess );
+ BEGIN { our @ISA = qw( KinoSearch::Util::ViewCharBuf ); }
+
+ sub new { confess "ZombieCharBuf objects can only be created from C." }
+
+ sub DESTROY { }
+}
+
+{
+ package KinoSearch::Util::Compat::DirManip;
+ use KinoSearch::Util::ToolSet qw( confess to_kino );
+ use KinoSearch::base qw( KinoSearch::Obj );
+ use File::Spec::Functions qw( rel2abs no_upwards );
+
+ sub absolutify { return rel2abs( $_[1] ) }
+
+ sub list_files {
+ my $dir_path = $_[1]->to_perl;
+ opendir( my $dir_handle, $dir_path )
+ or confess "Can't opendir '$dir_path': $!";
+ my @files = no_upwards( readdir $dir_handle );
+ return to_kino( \@files );
+ }
+}
+
+{
+ package KinoSearch::Util::DynVirtualTable;
+ use KinoSearch::base qw( KinoSearch::Util::VirtualTable );
+
+ sub find_parent_vtable {
+ my ( $ignore, $package ) = @_;
+ return _find_parent_vtable($package);
+ }
+
+ # Depth-first recursive search of @ISA.
+ sub _find_parent_vtable {
+ my $package = shift;
+ my $registry = _get_registry();
+ my $vtable;
+ no strict 'refs';
+ for my $parent ( @{"$package\::ISA"} ) {
+ $vtable = $registry->fetch($parent);
+ last if defined $vtable;
+ $vtable = _find_parent_vtable($parent);
+ last if defined $vtable;
+ }
+ return $vtable;
+ }
+
+ sub novel_native_methods {
+ my ( undef, $package ) = @_;
+ no strict 'refs';
+ my $stash = \%{"$package\::"};
+ my $methods = KinoSearch::Util::VArray->new(
+ capacity => scalar keys %$stash );
+ while ( my ( $symbol, $glob ) = each %$stash ) {
+ next if ref $glob;
+ next unless *$glob{CODE};
+ $methods->push( KinoSearch::Util::CharBuf->new($symbol) );
+ }
+ return $methods;
+ }
+}
+
+{
+ package KinoSearch::Util::IntMap;
+ use KinoSearch::base qw( KinoSearch::Obj );
+
+ our %new_PARAMS = ( ints => undef );
+}
+
+{
+ package KinoSearch::Util::Json;
+ use KinoSearch::base qw( Exporter );
+ use KinoSearch::Util::ToolSet qw( to_perl to_kino );
+
+ BEGIN {
+ our @EXPORT_OK = qw(
+ to_json
+ from_json
+ );
+ }
+
+ use JSON::XS qw();
+
+ my $json_encoder = JSON::XS->new->pretty(1)->canonical(1);
+
+ sub to_json { return $json_encoder->encode(shift) }
+ sub from_json { return $json_encoder->decode(shift) }
+
+ sub slurp_json {
+ shift; # useless callback obj
+ my %args = @_;
+ my $instream = $args{folder}->open_instream( $args{filename} );
+ my $len = $instream->length;
+ my $json;
+ $instream->read_bytes( $json, $len );
+ return to_kino( $json_encoder->decode($json) );
+ }
+
+ sub spew_json {
+ shift; # useless callback obj
+ my %args = @_;
+ my $perl_data = to_perl( $args{obj} );
+ my $json = $json_encoder->encode($perl_data);
+ my $outstream = $args{folder}->open_outstream( $args{filename} );
+ $outstream->print($json);
+ $outstream->close;
+ return;
+ }
+}
+
+{
+ package KinoSearch::Util::MathUtils;
+ use KinoSearch::base qw( Exporter );
+ our @EXPORT_OK = qw( fibonacci );
+}
+
+{
+ package KinoSearch::Util::PriorityQueue;
+ use KinoSearch::Util::ToolSet qw( to_perl );
+ use KinoSearch::base qw( KinoSearch::Obj );
+
+ sub pop_all { to_perl( shift->_pop_all ) }
+}
+
1;

__END__


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