Mailing List Archive

Author: creamyg
Date: 2008-07-28 11:50:45 -0700 (Mon, 28 Jul 2008)
New Revision: 3657

Modified:
trunk/perl/lib/KinoSearch.pm
trunk/perl/lib/KinoSearch/Index/IndexFileNames.pm
trunk/perl/lib/KinoSearch/Posting.pm
trunk/perl/lib/KinoSearch/Util/Debug.pm
trunk/perl/lib/KinoSearch/Util/Native.pm
trunk/perl/lib/KinoSearch/Util/StringHelper.pm
trunk/perl/lib/KinoSearch/Util/ToolSet.pm
Log:
Migrate the last Perl code in modules except for KinoSearch::base and items
under KinoSearch::Test.


Modified: trunk/perl/lib/KinoSearch/Index/IndexFileNames.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Index/IndexFileNames.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch/Index/IndexFileNames.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -1,22 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch;

-package KinoSearch::Index::IndexFileNames;
-use KinoSearch::Util::ToolSet qw( to_kino );
-use KinoSearch::base qw( Exporter );
-
-our @EXPORT_OK = qw(
- gen_from_filename
- unused_files
-);
-
-# Determine which KinoSearch files in the InvIndex are not currently in use.
-# Leave non-KS files alone.
-sub unused_files {
- my ( $files, @snapshots ) = @_;
- return _unused_files( to_kino($files), to_kino( \@snapshots ) );
-}
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Posting.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Posting.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch/Posting.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -1,11 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch;

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

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Debug.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Debug.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch/Util/Debug.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -3,20 +3,6 @@

use KinoSearch;

-package KinoSearch::Util::Debug;
-use KinoSearch::base qw( Exporter );
-
-our @EXPORT_OK = qw(
- DEBUG
- DEBUG_PRINT
- DEBUG_ENABLED
- ASSERT
- set_env_cache
- num_allocated
- num_freed
- num_globals
-);
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/Native.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/Native.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch/Util/Native.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -1,18 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch;

-package KinoSearch::Util::Native;
-use KinoSearch::base qw( KinoSearch::Obj Exporter );
-
-sub _test { return scalar @_ }
-
-sub _test_obj {
- $KinoSearch::Util::Native::testobj
- ||= KinoSearch::Util::ByteBuf->new('blah');
- KinoSearch::Util::Debug->track_globals;
- return $KinoSearch::Util::Native::testobj;
-}
-
1;

__END__
@@ -27,6 +14,25 @@

=cut

+IV
+_test(...)
+CODE:
+ RETVAL = items;
+OUTPUT: RETVAL
+
+SV*
+_test_obj(...)
+CODE:
+{
+ kino_ByteBuf *test_obj = kino_BB_new_str("blah", 4);
+ SV *pack_var = get_sv("KinoSearch::Util::Native::testobj", 1);
+ RETVAL = Kino_Obj_To_Native(test_obj);
+ SvSetSV_nosteal(pack_var, RETVAL);
+ REFCOUNT_DEC(test_obj);
+ CHY_UNUSED_VAR(items);
+}
+OUTPUT: RETVAL
+
void
_callback(obj)
kino_Obj *obj;

Modified: trunk/perl/lib/KinoSearch/Util/StringHelper.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/StringHelper.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch/Util/StringHelper.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -1,18 +1,5 @@
-use strict;
-use warnings;
+use KinoSearch;

-package KinoSearch::Util::StringHelper;
-use KinoSearch::base qw( Exporter );
-
-our @EXPORT_OK = qw(
- utf8_flag_on
- utf8_flag_off
- to_base36
- from_base36
- utf8ify
- utf8_valid
-);
-
1;

__END__

Modified: trunk/perl/lib/KinoSearch/Util/ToolSet.pm
===================================================================
--- trunk/perl/lib/KinoSearch/Util/ToolSet.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch/Util/ToolSet.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -1,195 +1,9 @@
-use strict;
-use warnings;
+use KinoSearch;

-package KinoSearch::Util::ToolSet;
-use bytes;
-no bytes;
-
-use KinoSearch::base qw( Exporter );
-
-use Carp qw( carp croak cluck confess );
-# Everything except readonly and set_prototype.
-use Scalar::Util qw(
- refaddr
- blessed
- dualvar
- isweak
- refaddr
- reftype
- tainted
- weaken
- isvstring
- looks_like_number
-);
-use Storable qw( nfreeze thaw );
-
-our @EXPORT_OK = qw(
- carp
- croak
- cluck
- confess
-
- refaddr
- blessed
- dualvar
- isweak
- refaddr
- reftype
- tainted
- weaken
- isvstring
- looks_like_number
-
- nfreeze
- thaw
-
- to_kino
- to_perl
- verify_args
- a_isa_b
- kerror
-);
-
-# Translate a complex data structure in Perl to the equivalent in KinoSearch C
-# structures. Undefined elements will trigger a warning and be turned to
-# empty strings.
-sub to_kino {
- my $input = shift;
- my $reftype = reftype($input);
-
- if ( !$reftype ) {
- return KinoSearch::Util::CharBuf->new($input);
- }
- elsif ( $reftype eq 'HASH' ) {
- my $capacity = scalar keys %$input;
- my $hash = KinoSearch::Util::Hash->new( capacity => $capacity );
- while ( my ( $k, $v ) = each %$input ) {
- my $val = to_kino($v);
- $hash->store( $k, $val );
- }
- return $hash;
- }
- elsif ( $reftype eq 'ARRAY' ) {
- my $varray
- = KinoSearch::Util::VArray->new( capacity => scalar @$input );
- $varray->push( to_kino($_) ) for @$input;
- return $varray;
- }
- elsif ( a_isa_b( $input, 'KinoSearch::Obj' ) ) {
- return $input;
- }
-}
-
-# Transform what may or may not be a KinoSearch object into a Perl complex
-# data structure if possible.
-sub to_perl {
- my $input = shift;
- if ( blessed($input) and $input->can('to_pobj') ) {
- return $input->to_pobj;
- }
- else {
- return $input;
- }
-}
-
-my $kerror;
-
-sub kerror {$kerror}
-
-# Verify that named parameters exist in a defaults hash.
-sub verify_args {
- my $defaults = shift; # leave the rest of @_ intact
-
- # Verify that args came in pairs.
- if ( @_ % 2 ) {
- my ( $package, $filename, $line ) = caller(1);
- $kerror
- = "Parameter error: odd number of args at $filename line $line\n";
- return 0;
- }
-
- # Verify keys, ignore values.
- while (@_) {
- my ( $var, undef ) = ( shift, shift );
- next if exists $defaults->{$var};
- my ( $package, $filename, $line ) = caller(1);
- $kerror = "Invalid parameter: '$var' at $filename line $line\n";
- return 0;
- }
-
- return 1;
-}
-
-=begin comment
-
-a_isa_b serves the same purpose as the isa method from UNIVERSAL, only it is
-called as a function rather than a method.
-
- # Safer than $foo->isa($class), which crashes if $foo isn't blessed.
- my $confirm = a_isa_b( $foo, $class );
-
-=end comment
-=cut
-
-sub a_isa_b {
- my ( $item, $class_name ) = @_;
- return 0 unless blessed($item);
- return $item->isa($class_name);
-}
-
1;

__END__

-=head1 NAME
-
-KinoSearch::Util::ToolSet - Namespace pollution.
-
-=head1 PRIVATE CLASS
-
-This is a private class and the interface may change radically and without
-warning. Do not use it on its own.
-
-=head1 SYNOPSIS
-
- use KinoSearch::Util::ToolSet;
-
-=head1 DESCRIPTION
-
-KinoSearch::Util::ToolSet makes a slew of commonly needed symbols available to
-other modules in the KinoSearch suite. At one time it was implemented using
-David Golden's L<ToolSet> module, but in keeping with the philosophy of
-minimizing non-core dependencies, a 90% solution based on Exporter has been
-substituted.
-
- use KinoSearch::Util::ToolSet;
-
-... is effectively an alias for...
-
- use bytes; no bytes;
- use Carp qw( carp croak cluck confess );
- use Storable qw( nfreeze thaw );
- use Scalar::Util qw(
- refaddr
- blessed
- dualvar
- isweak
- refaddr
- reftype
- tainted
- weaken
- isvstring
- looks_like_number
- );
- use KinoSearch::Util::MathUtils qw( ceil );
-
-Two issues deserve special attention.
-
-First, the C<use bytes; no bytes;> combo ensures that subroutines within the
-bytes:: namespace, such as bytes::length, will be available, while still
-keeping character semantics enabled by default -- so regexes work as expected,
-etc.
-
Second, the C<use KinoSearch> line does a LOT more than it appears to at first
glance -- it loads ALL of the XS routines in the entire KinoSearch suite. See
L<KinoSearch::Docs::DevGuide> for an explanation.

Modified: trunk/perl/lib/KinoSearch.pm
===================================================================
--- trunk/perl/lib/KinoSearch.pm 2008-07-28 17:51:19 UTC (rev 3656)
+++ trunk/perl/lib/KinoSearch.pm 2008-07-28 18:50:45 UTC (rev 3657)
@@ -26,6 +26,142 @@
our @EXPORT_OK = qw( kdump );

{
+ package KinoSearch::Util::StringHelper;
+ BEGIN {
+ push our @ISA, 'Exporter';
+ our @EXPORT_OK = qw(
+ utf8_flag_on
+ utf8_flag_off
+ to_base36
+ from_base36
+ utf8ify
+ utf8_valid
+ );
+ }
+}
+
+{
+ package KinoSearch::Util::ToolSet;
+
+ # Ensure that subroutines within the bytes:: namespace, such as
+ # bytes::length, will be available, while still keeping character
+ # semantics enabled by default -- so regexes work as expected, etc.
+ use bytes;
+ no bytes;
+
+ use Carp qw( carp croak cluck confess );
+ use Scalar::Util qw(
+ refaddr
+ blessed
+ reftype
+ weaken
+ );
+ use Storable qw( nfreeze thaw );
+
+ BEGIN {
+ push our @ISA, 'Exporter';
+ our @EXPORT_OK = qw(
+ carp
+ croak
+ cluck
+ confess
+
+ refaddr
+ blessed
+ reftype
+ weaken
+
+ nfreeze
+ thaw
+
+ to_kino
+ to_perl
+ verify_args
+ a_isa_b
+ kerror
+ );
+ }
+
+ # Translate a complex data structure in Perl to the equivalent in
+ # KinoSearch C structures. Undefined elements will trigger a warning and
+ # be turned to empty strings.
+ sub to_kino {
+ my $input = shift;
+ my $reftype = reftype($input);
+
+ if ( !$reftype ) {
+ return KinoSearch::Util::CharBuf->new($input);
+ }
+ elsif ( $reftype eq 'HASH' ) {
+ my $capacity = scalar keys %$input;
+ my $hash = KinoSearch::Util::Hash->new( capacity => $capacity );
+ while ( my ( $k, $v ) = each %$input ) {
+ my $val = to_kino($v);
+ $hash->store( $k, $val );
+ }
+ return $hash;
+ }
+ elsif ( $reftype eq 'ARRAY' ) {
+ my $varray
+ = KinoSearch::Util::VArray->new( capacity => scalar @$input );
+ $varray->push( to_kino($_) ) for @$input;
+ return $varray;
+ }
+ elsif ( a_isa_b( $input, 'KinoSearch::Obj' ) ) {
+ return $input;
+ }
+ }
+
+ # Transform what may or may not be a KinoSearch object into a Perl complex
+ # data structure if possible.
+ sub to_perl {
+ my $input = shift;
+ if ( blessed($input) and $input->can('to_pobj') ) {
+ return $input->to_pobj;
+ }
+ else {
+ return $input;
+ }
+ }
+
+ my $kerror;
+
+ sub kerror {$kerror}
+
+ # Verify that named parameters exist in a defaults hash.
+ sub verify_args {
+ my $defaults = shift; # leave the rest of @_ intact
+
+ # Verify that args came in pairs.
+ if ( @_ % 2 ) {
+ my ( $package, $filename, $line ) = caller(1);
+ $kerror
+ = "Parameter error: odd number of args at $filename line $line\n";
+ return 0;
+ }
+
+ # Verify keys, ignore values.
+ while (@_) {
+ my ( $var, undef ) = ( shift, shift );
+ next if exists $defaults->{$var};
+ my ( $package, $filename, $line ) = caller(1);
+ $kerror = "Invalid parameter: '$var' at $filename line $line\n";
+ return 0;
+ }
+
+ return 1;
+ }
+
+ # a_isa_b serves the same purpose as the isa method from UNIVERSAL, only
+ # it is called as a function rather than a method.
+ sub a_isa_b {
+ my ( $item, $class_name ) = @_;
+ return 0 unless blessed($item);
+ return $item->isa($class_name);
+ }
+}
+
+{
package KinoSearch::Analysis::Analyzer;
use KinoSearch::base qw( KinoSearch::Obj );
use KinoSearch::Util::StringHelper qw( utf8_flag_on );
@@ -266,7 +402,7 @@
my %args = @_ == 1 ? ( similarity => $_[0] ) : (@_);
confess("missing required argument 'similarity'")
unless a_isa_b( $args{similarity},
- "KinoSearch::Search::Similarity" );
+ "KinoSearch::Search::Similarity" );
return KinoSearch::Posting::ScorePosting->new(%args);
}
}
@@ -291,8 +427,10 @@
@{ $self->get_spans->to_perl } };

# Sort by temperature, lowest to highest.
- $sorted_loc{$$self} = [ sort { $locations->{$a} <=> $locations->{$b} }
- keys %$locations ];
+ $sorted_loc{$$self} = [.
+ sort { $locations->{$a} <=> $locations->{$b} }
+ keys %$locations
+ ];

return $self;
}
@@ -620,6 +758,23 @@
}

{
+ package KinoSearch::Index::IndexFileNames;
+ use KinoSearch::Util::ToolSet qw( to_kino );
+ BEGIN {
+ push our @ISA, 'Exporter';
+ our @EXPORT_OK = qw(
+ gen_from_filename
+ unused_files
+ );
+ }
+
+ sub unused_files {
+ my ( $files, @snapshots ) = @_;
+ return _unused_files( to_kino($files), to_kino( \@snapshots ) );
+ }
+}
+
+{
package KinoSearch::Index::IndexReader;
use KinoSearch::Util::ToolSet qw( confess a_isa_b );
use KinoSearch::base qw( KinoSearch::Obj );
@@ -659,7 +814,7 @@
if ( defined $lock_factory ) {
confess("Not a KinoSearch::Store::LockFactory")
unless a_isa_b( $lock_factory,
- "KinoSearch::Store::LockFactory" );
+ "KinoSearch::Store::LockFactory" );
}

$self->obtain_commit_lock if defined $lock_factory;
@@ -677,7 +832,7 @@
or die "Strange snapshot name: $latest_snapshot_file";
$gen = from_base36($1);

- # Get a read lock on the most recent snapshot file if
+ # Get a read lock on the most recent snapshot file if
# indicated.
if ( defined $lock_factory ) {
$self->obtain_read_lock($latest_snapshot_file);
@@ -1122,6 +1277,23 @@
}

{
+ package KinoSearch::Util::Debug;
+ BEGIN {
+ push our @ISA, 'Exporter';
+ our @EXPORT_OK = qw(
+ DEBUG
+ DEBUG_PRINT
+ DEBUG_ENABLED
+ ASSERT
+ set_env_cache
+ num_allocated
+ num_freed
+ num_globals
+ );
+ }
+}
+
+{
package KinoSearch::Util::DynVirtualTable;
use KinoSearch::base qw( KinoSearch::Util::VirtualTable );

@@ -1215,6 +1387,15 @@
}

{
+ package KinoSearch::Util::Native;
+ BEGIN {
+ if ( !__PACKAGE__->isa('KinoSearch::Obj') ) {
+ push our @ISA, 'KinoSearch::Obj';
+ }
+ }
+}
+
+{
package KinoSearch::Util::PriorityQueue;
use KinoSearch::Util::ToolSet qw( to_perl );
use KinoSearch::base qw( KinoSearch::Obj );


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