/[jsFind]/trunk/jsFind.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /trunk/jsFind.pm

Parent Directory | Revision Log | View Patch Patch

-revision 8 by dpavlin,
Wed Jul 21 15:44:15 2004 UTC
+revision 15 by dpavlin,
Sun Sep  5 17:57:21 2004 UTC
 Line 1
  package jsFind;
- use 5.008004;
+ use 5.005;
  use strict;
  use warnings;
+ use HTML::Entities;
- our $VERSION = '0.01';
+ our $VERSION = '0.04';
+ use Exporter 'import';
+ use Carp;
+ our @ISA = qw(Exporter);
+ BEGIN {
+         import 'jsFind::Node';
+ }
  =head1 NAME
-Line 13 
 jsFind - generate index for jsFind using
+Line 23 
 jsFind - generate index for jsFind using
  =head1 SYNOPSIS
    use jsFind;
+   my $t = new jsFind(B => 4);
+   my $f = 1;
+   foreach my $k (qw{minima ut dolorem sapiente voluptatem}) {
+         $t->B_search(Key => $k,
+                 Data => {
+                         "path" => {
+                         t => "word $k",
+                         f => $f },
+                 },
+                 Insert => 1,
+                 Append => 1,
+         );
+   }
  =head1 DESCRIPTION
-Line 36 
 You can programatically (and incremental
+Line 57 
 You can programatically (and incremental
  =back
- =head1 METHODS
+ You can also examine examples which come as tests with this module,
+ for example C<t/04words.t>.
- This module contains two packages C<jsFind> and C<jsFind::Node>.
- =head2 jsFind methods
+ =head1 jsFind methods
- =cut
- use Exporter 'import';
+ C<jsFind> is mode implementing methods which you, the user, are going to
- use Carp;
+ use to create indexes.
- our @ISA = qw(Exporter);
+ =head2 new
- BEGIN {
-         import 'jsFind::Node';
- }
- =head3 new
  Create new tree. Arguments are C<B> which is maximum numbers of keys in
  each node and optional C<Root> node. Each root node may have child nodes.
-Line 82 
 sub new {
+Line 94 
 sub new {
    bless { B => $B, Root => $Root } => $package;
  }
- =head3 B_search
+ =head2 B_search
  Search, insert, append or replace data in B-Tree
-Line 224 
 sub split_and_promote {
+Line 236 
 sub split_and_promote {
    }
  }
- =head3 B
+ =head2 B
  Return B (maximum number of keys)
-Line 236 
 sub B {
+Line 248 
 sub B {
    $_[0]{B};
  }
- =head3 root
+ =head2 root
  Returns root node
-Line 250 
 sub root {
+Line 262 
 sub root {
    $self->{Root};
  }
- =head3 node_overfull
+ =head2 node_overfull
  Returns if node is overfull
-Line 264 
 sub node_overfull {
+Line 276 
 sub node_overfull {
    $node->size > $self->B;
  }
- =head3 to_string
+ =head2 to_string
  Returns your tree as formatted string.
-Line 278 
 sub to_string {
+Line 290 
 sub to_string {
    $_[0]->root->to_string;
  }
- =head3 to_dot
+ =head2 to_dot
  Create Graphviz graph of your tree
-Line 296 
 sub to_dot {
+Line 308 
 sub to_dot {
          return $dot;
  }
- =head3 to_jsfind
+ =head2 to_jsfind
  Create xml index files for jsFind. This should be called after
  your B-Tree has been filled with data.
-Line 305 
 your B-Tree has been filled with data.
+Line 317 
 your B-Tree has been filled with data.
  Returns number of nodes in created tree.
+ There is also longer version if you want to recode your data charset
+ into different one (probably UTF-8):
+  $root->to_jsfind('/full/path/to/index/dir/','ISO-8859-2','UTF-8');
+ Destination encoding is UTF-8 by default, so you don't have to specify it.
+  $root->to_jsfind('/full/path/to/index/dir/','WINDOWS-1250');
  =cut
+ my $iconv;
+ my $iconv_l1;
  sub to_jsfind {
          my $self = shift;
          my $path = shift || confess "to_jsfind need path to your index!";
+         my ($from_cp,$to_cp) = @_;
+         $to_cp ||= 'UTF-8';
+         if ($from_cp && $to_cp) {
+                 $iconv = Text::Iconv->new($from_cp,$to_cp);
+         }
+         $iconv_l1 = Text::Iconv->new('ISO-8859-1',$to_cp);
          $path .= "/" if ($path =~ /\/$/);
-         carp "create directory for index '$path': $!" if (! -w $path);
+         #carp "creating directory for index '$path'" if (! -w $path);
          return $self->root->to_jsfind($path,"0");
  }
-Line 324 
 sub default_cmp {
+Line 357 
 sub default_cmp {
    $_[0] cmp $_[1];
  }
+ =head2 _recode
+ This is internal function to recode charset.
+ It will also try to decode entities in data using L<HTML::Entities>.
+ =cut
+ sub _recode {
+         my $self = shift;
+         my $text = shift || return;
+         sub _decode_html_entities {
+                 my $data = shift || return;
+                 $data = $iconv_l1->convert(decode_entities($data)) || croak "entity decode problem: $data";
+         }
+         if ($iconv) {
+                 $text = $iconv->convert($text) || $text && carp "convert problem: $text";
+                 $text =~ s/(\&\w+;)/_decode_html_entities($1)/ges;
+         }
+         return $text;
+ }
  #####################################################################
- =head2 jsFind::Node methods
+ =head1 jsFind::Node methods
  Each node has C<k> key-data pairs, with C<B> <= C<k> <= C<2B>, and
  each has C<k+1> subnodes, which might be null.
-Line 348 
 use strict;
+Line 406 
 use strict;
  use Carp;
  use File::Path;
+ use Text::Iconv;
+ use POSIX;
+ use base 'jsFind';
  my $KEYS = 0;
  my $DATA = 1;
  my $SUBNODES = 2;
- =head3 new
+ =head2 new
  Create New node
-Line 373 
 sub new {
+Line 435 
 sub new {
    bless [@_] => $package;
  }
- =head3 locate_key
+ =head2 locate_key
  Locate key in node using linear search. This should probably be replaced
  by binary search for better performance.
-Line 410 
 sub locate_key {
+Line 472 
 sub locate_key {
  }
- =head3 emptynode
+ =head2 emptynode
  Creates new empty node
-Line 423 
 sub emptynode {
+Line 485 
 sub emptynode {
    new($_[0]);                   # Pass package name, but not anything else.
  }
- =head3 is_empty
+ =head2 is_empty
  Test if node is empty
-Line 437 
 sub is_empty {
+Line 499 
 sub is_empty {
    !defined($self) || $#$self < 0;
  }
- =head3 key
+ =head2 key
  Return C<$i>th key from node
-Line 453 
 sub key {
+Line 515 
 sub key {
     $_[0]->[$KEYS][$_[1]];
  }
- =head3 data
+ =head2 data
  Return C<$i>th data from node
-Line 466 
 sub data {
+Line 528 
 sub data {
    $self->[$DATA][$n];
  }
- =head3 kdp_replace
+ =head2 kdp_replace
  Set key data pair for C<$i>th element in node
-Line 487 
 sub kdp_replace {
+Line 549 
 sub kdp_replace {
     $self->[$DATA][$n]];
  }
- =head3 kdp_insert
+ =head2 kdp_insert
+ Insert key/data pair in tree
-  # No return value.
+   $node->kdp_insert("key value" => "data value");
+ No return value.
  =cut
-Line 508 
 sub kdp_insert {
+Line 574 
 sub kdp_insert {
    splice(@{$self->[$SUBNODES]}, $where, 0, undef);
  }
- =head3 kdp_append
+ =head2 kdp_append
  Adds new data keys and values to C<$i>th element in node
-Line 529 
 sub kdp_append {
+Line 595 
 sub kdp_append {
     $self->[$DATA][$n]];
  }
- =head3 subnode
+ =head2 subnode
  Set new or return existing subnode
-Line 547 
 sub subnode {
+Line 613 
 sub subnode {
    $self->[$SUBNODES][$n];
  }
- =head3 is_leaf
+ =head2 is_leaf
  Test if node is leaf
-Line 560 
 sub is_leaf {
+Line 626 
 sub is_leaf {
    ! defined $self->[$SUBNODES][0]; # undefined subnode means leaf node.
  }
- =head3 size
+ =head2 size
  Return number of keys in the node
-Line 573 
 sub size {
+Line 639 
 sub size {
    return scalar(@{$self->[$KEYS]});
  }
- =head3 halves
+ =head2 halves
+ Split node into two halves so that keys C<0 .. $n-1> are in one node
+ and keys C<$n+1 ... $size> are in the other.
-  # Accept an index $n
+   my ($left_node, $right_node, $kdp) = $node->halves($n);
-  # Divide into two nodes so that keys 0 .. $n-1 are in one node
-  # and keys $n+1 ... $size are in the other.
  =cut
-Line 601 
 sub halves {
+Line 668 
 sub halves {
    ($self->new(@left), $self->new(@right), \@middle);
  }
- =head3 to_string
+ =head2 to_string
  Dumps tree as string
-Line 652 
 sub to_string {
+Line 719 
 sub to_string {
  =end comment
- =head3 to_dot
+ =head2 to_dot
  Recursivly walk nodes of tree
-Line 691 
 sub to_dot {
+Line 758 
 sub to_dot {
          $dot;
  }
- =head3 to_jsfind
+ =head2 to_xml
+ Escape <, >, & and ", and to produce valid XML
+ =cut
+ my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
+ my $escape_re  = join '|' => keys %escape;
+ sub to_xml {
+         my $self = shift || confess "you should call to_xml as object!";
+         my $d = shift || return;
+         $d = $self->SUPER::_recode($d);
+         confess "escape_re undefined!" unless ($escape_re);
+         $d =~ s/($escape_re)/$escape{$1}/g;
+         return $d;
+ }
+ =head2 base62
+ Convert number to base62 (used for jsFind index filenames).
+  my $n = $tree->base62(50);
+ =cut
+ sub base62 {
+         my $self = shift;
+         my $value = shift;
+         confess("need non-negative number") if (! defined($value) || $value < 0);
+         my @digits = qw(
+1 2 3 4 5 6 7 8 9
+                 a b c d e f g h i j k l m n o p q r s t u v w x y z
+                 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
+         );
+         my $base = scalar(@digits);
+         my $out = "";
+         my $pow = 1;
+         my $pos = 0;
+         if($value == 0) {
+                 return "0";
+         }
+         while($value > 0) {
+                 $pos = $value % $base;
+                 $out = $digits[$pos] . $out;
+                 $value = floor($value/$base);
+                 $pow *= $base;
+         }
+         return $out;
+ }
+ =head2 to_jsfind
  Create jsFind xml files
-Line 710 
 sub to_jsfind {
+Line 837 
 sub to_jsfind {
          confess("path is undefined.") unless ($path);
          confess("file is undefined. Did you call \$t->root->to_jsfind(..) instead of \$t->to_jsfind(..) ?") unless (defined($file));
+         $file = $self->base62($file);
          my $nr_keys = 0;
          my ($k, $d, $s) = @$self;
-Line 721 
 sub to_jsfind {
+Line 850 
 sub to_jsfind {
                  my $key = lc($k->[$i]);
                  if ($key) {
-                         $key_xml .= qq{<k>$key</k>};
+                         $key_xml .= '<k>'.$self->to_xml($key).'</k>';
-                         $data_xml .= qq{<e>};
+                         $data_xml .= '<e>';
          #use Data::Dumper;
          #print Dumper($d->[$i]);
                          foreach my $path (keys %{$d->[$i]}) {
-                                 $data_xml .= '<l f="'.($d->[$i]->{$path}->{'f'} || 1).'" t="'.($d->[$i]->{$path}->{'t'} || 'no title').'">'.$path.'</l>';
+                                 $data_xml .= '<l f="'.($d->[$i]->{$path}->{'f'} || 1).'" t="'.$self->to_xml($d->[$i]->{$path}->{'t'} || 'no title').'">'.$self->to_xml($path).'</l>';
                                  $nr_keys++;
                          }
-                         $data_xml .= qq{</e>};
+                         $data_xml .= '</e>';
                  }
                  $nr_keys += $s->[$i]->to_jsfind("$path/$file","$i") if ($s->[$i]);
          }
-         $key_xml .= "</n>";
+         $key_xml .= '</n>';
-         $data_xml .= "</d>";
+         $data_xml .= '</d>';
          if (! -e $path) {
                  mkpath($path) || croak "can't create dir '$path': $!";
-Line 763 
 jsFind web site L<http://www.elucidsoft.
+Line 892 
 jsFind web site L<http://www.elucidsoft.
  B-Trees in perl web site L<http://perl.plover.com/BTree/>
+ This module web site L<https://www.rot13.org/~dpavlin/jsFind.html>
  =head1 AUTHORS
  Mark-Jonson Dominus E<lt>mjd@pobox.comE<gt> wrote C<BTree.pm> which was

 Legend:



Removed from v.8
 


changed lines


 
Added in v.15
 Legend:



Removed from v.8
 


changed lines


 
Added in v.15
-Removed from v.8
+Added in v.15

	ViewVC Help
Powered by ViewVC 1.1.26