File Coverage

blib/lib/MyConText/Column.pm
Criterion Covered Total %
statement 3 64 4.6
branch 0 20 0.0
condition n/a
subroutine 1 7 14.2
pod 0 5 0.0
total 4 96 4.1


line stmt bran cond sub pod time code
1              
2             package MyConText::Column;
3 1     1   702 use strict;
  1         2  
  1         1011  
4              
5             # Open in the backend just sets the object
6             sub open {
7 0     0 0   my ($class, $ctx) = @_;
8 0           return bless { 'ctx' => $ctx }, $class;
9             }
10             # Create creates the table(s) according to the parameters
11             sub _create_tables {
12 0     0     my ($class, $ctx) = @_;
13 0           my $COUNT_FIELD = '';
14 0 0         if ($ctx->{'count_bits'}) {
15 0           $COUNT_FIELD = "count $MyConText::BITS_TO_INT{$ctx->{'count_bits'}} unsigned,"
16             }
17 0           my $CREATE_DATA = <
18             create table $ctx->{'data_table'} (
19             word_id $MyConText::BITS_TO_INT{$ctx->{'word_id_bits'}} unsigned not null,
20             doc_id $MyConText::BITS_TO_INT{$ctx->{'doc_id_bits'}} unsigned not null,
21             $COUNT_FIELD
22             index (word_id),
23             index (doc_id)
24             )
25             EOF
26              
27 0 0         $ctx->{'word_id_table'} = $ctx->{'table'}.'_words'
28             unless defined $ctx->{'word_id_table'};
29            
30            
31 0           my $CREATE_WORD_ID = <
32             create table $ctx->{'word_id_table'} (
33             word varchar($ctx->{'word_length'}) binary
34             default '' not null,
35             id $MyConText::BITS_TO_INT{$ctx->{'word_id_bits'}} unsigned not null auto_increment,
36             primary key (id),
37             unique (word)
38             )
39             EOF
40              
41 0           my $dbh = $ctx->{'dbh'};
42 0 0         $dbh->do($CREATE_DATA) or return $dbh->errstr;
43 0           push @{$ctx->{'created_tables'}}, $ctx->{'data_table'};
  0            
44 0 0         $dbh->do($CREATE_WORD_ID) or return $dbh->errstr;
45 0           push @{$ctx->{'created_tables'}}, $ctx->{'word_id_table'};
  0            
46 0           return;
47             }
48             sub add_document {
49 0     0 0   my ($self, $id, $words) = @_;
50 0           my $ctx = $self->{'ctx'};
51 0           my $dbh = $ctx->{'dbh'};
52 0           my $data_table = $ctx->{'data_table'};
53 0           my $word_id_table = $ctx->{'word_id_table'};
54 0 0         if (not defined $self->{'insert_wordid_sth'}) {
55 0           $self->{'insert_wordid_sth'} = $dbh->prepare("
56             insert into $word_id_table (word) values (?)
57             ");
58 0           $self->{'insert_wordid_sth'}->{'PrintError'} = 0;
59 0           $self->{'insert_wordid_sth'}->{'RaiseError'} = 0;
60             }
61 0           my $insert_wordid_sth = $self->{'insert_wordid_sth'};
62              
63 0           my $count_bits = $ctx->{'count_bits'};
64 0 0         my $insert_worddoc_sth = ( defined $self->{'insert_worddoc_sth'}
    0          
65             ? $self->{'insert_worddoc_sth'}
66             : $self->{'insert_worddoc_sth'} = (
67             $count_bits
68             ? $dbh->prepare("
69             insert into $data_table
70             select id, ?, ? from $word_id_table
71             where word = ?")
72             : $dbh->prepare("
73             insert into $data_table
74             select id, ?, from $word_id_table
75             where word = ?")
76             ) );
77 0           my $num_words = 0;
78 0           for my $word ( keys %$words ) {
79 0           $insert_wordid_sth->execute($word);
80 0 0         if ($count_bits) {
81 0           $insert_worddoc_sth->execute($id, $words->{$word}, $word);
82             }
83             else {
84 0           $insert_worddoc_sth->execute($id, $word);
85             }
86 0           $num_words += $words->{$word};
87             }
88 0           return $num_words;
89             }
90             sub delete_document {
91 0     0 0   my $self = shift;
92 0           my $ctx = $self->{'ctx'};
93 0           my $dbh = $ctx->{'dbh'};
94 0           my $data_table = $ctx->{'data_table'};
95 0           my $sth = $dbh->prepare("delete from $data_table where doc_id = ?");
96 0           for my $id (@_) { $sth->execute($id); }
  0            
97             }
98             sub update_document {
99 0     0 0   my ($self, $id, $words) = @_;
100 0           $self->delete_document($id);
101 0           $self->add_document($id, $words);
102             }
103             sub contains_hashref {
104 0     0 0   my $self = shift;
105 0           my $ctx = $self->{'ctx'};
106 0           my $dbh = $ctx->{'dbh'};
107 0           my $data_table = $ctx->{'data_table'};
108 0           my $word_id_table = $ctx->{'word_id_table'};
109              
110 0           my $count_bits = $ctx->{'count_bits'};
111 0 0         my $sth = ( defined $self->{'get_data_sth'}
    0          
112             ? $self->{'get_data_sth'}
113             : ( $count_bits
114             ? $self->{'get_data_sth'} = $dbh->prepare(
115             "select doc_id, count
116             from $data_table, $word_id_table
117             where word like ?
118             and id = word_id" )
119             : $self->{'get_data_sth'} = $dbh->prepare(
120             "select doc_id, 1
121             from $data_table, $word_id_table
122             where word like ?
123             and id = word_id" )
124             ) );
125              
126 0           my $out = {};
127 0           for my $word (@_) {
128 0           $sth->execute($word);
129 0           while (my ($doc, $count) = $sth->fetchrow_array) {
130 0           $out->{$doc} += $count;
131             }
132 0           $sth->finish;
133             }
134 0           $out;
135             }
136              
137             *parse_and_index_data = \&MyConText::parse_and_index_data_count;
138              
139             1;
140