/[Search-Estraier]/trunk/lib/Search/Estraier.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Search/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 6 by dpavlin, Wed Jan 4 14:48:11 2006 UTC revision 14 by dpavlin, Wed Jan 4 21:51:01 2006 UTC
# Line 43  implementation. It also includes methods Line 43  implementation. It also includes methods
43    
44  package Search::Estraier::Document;  package Search::Estraier::Document;
45    
46    use Carp qw/croak confess/;
47    
48  =head1 Search::Estraier::Document  =head1 Search::Estraier::Document
49    
50    This class implements Document which is collection of attributes
51    (key=value), vectors (also key value) display text and hidden text.
52    
53  Document for HyperEstraier  Document for HyperEstraier
54    
55  =head2 new  =head2 new
56    
57    Create new document, empty or from draft.
58    
59    my $doc = new Search::HyperEstraier::Document;    my $doc = new Search::HyperEstraier::Document;
60      my $doc2 = new Search::HyperEstraier::Document( $draft );
61    
62  =cut  =cut
63    
64  sub new {  sub new {
65          my $class = shift;          my $class = shift;
66          my $self = {@_};          my $self = {};
67          bless($self, $class);          bless($self, $class);
68    
69          $self->{id} = -1;          $self->{id} = -1;
70    
71            my $draft = shift;
72    
73            if ($draft) {
74                    my $in_text = 0;
75                    foreach my $line (split(/\n/, $draft)) {
76    
77                            if ($in_text) {
78                                    if ($line =~ /^\t/) {
79                                            push @{ $self->{htexts} }, substr($line, 1);
80                                    } else {
81                                            push @{ $self->{dtexts} }, $line;
82                                    }
83                                    next;
84                            }
85    
86                            if ($line =~ m/^%VECTOR\t(.+)$/) {
87                                    my @fields = split(/\t/, $1);
88                                    for my $i ( 0 .. ($#fields - 1) ) {
89                                            $self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
90                                            $i++;
91                                    }
92                                    next;
93                            } elsif ($line =~ m/^%/) {
94                                    # What is this? comment?
95                                    #warn "$line\n";
96                                    next;
97                            } elsif ($line =~ m/^$/) {
98                                    $in_text = 1;
99                                    next;
100                            } elsif ($line =~ m/^(.+)=(.+)$/) {
101                                    $self->{attrs}->{ $1 } = $2;
102                                    next;
103                            }
104    
105                            warn "draft ignored: $line\n";
106                    }
107            }
108    
109          $self ? return $self : return undef;          $self ? return $self : return undef;
110  }  }
111    
# Line 70  Add an attribute. Line 116  Add an attribute.
116    
117    $doc->add_attr( name => 'value' );    $doc->add_attr( name => 'value' );
118    
119  B<FIXME>: delete attribute using  Delete attribute using
120    
121    $doc->add_attr( name => undef );    $doc->add_attr( name => undef );
122    
# Line 81  sub add_attr { Line 127  sub add_attr {
127          my $attrs = {@_};          my $attrs = {@_};
128    
129          while (my ($name, $value) = each %{ $attrs }) {          while (my ($name, $value) = each %{ $attrs }) {
130                  push @{ $self->{attrs}->{_s($name)} }, _s($value);                  if (! defined($value)) {
131                            delete( $self->{attrs}->{_s($name)} );
132                    } else {
133                            $self->{attrs}->{_s($name)} = _s($value);
134                    }
135          }          }
136    
137            return 1;
138  }  }
139    
140    
# Line 132  sub id { Line 184  sub id {
184          return $self->{id};          return $self->{id};
185  }  }
186    
187    =head2 attr_names
188    
189    Returns array with attribute names from document object.
190    
191      my @attrs = $doc->attr_names;
192    
193    =cut
194    
195    sub attr_names {
196            my $self = shift;
197            croak "attr_names return array, not scalar" if (! wantarray);
198            return sort keys %{ $self->{attrs} };
199    }
200    
201    
202    =head2 attr
203    
204    Returns value of an attribute.
205    
206      my $value = $doc->attr( 'attribute' );
207    
208    =cut
209    
210    sub attr {
211            my $self = shift;
212            my $name = shift;
213    
214            return $self->{'attrs'}->{ $name };
215    }
216    
217    
218    =head2 texts
219    
220    Returns array with text sentences.
221    
222      my @texts = $doc->texts;
223    
224    =cut
225    
226    sub texts {
227            my $self = shift;
228            confess "texts return array, not scalar" if (! wantarray);
229            return @{ $self->{dtexts} };
230    }
231    
232    =head2 cat_texts
233    
234    Return whole text as single scalar.
235    
236     my $text = $doc->cat_texts;
237    
238    =cut
239    
240    sub cat_texts {
241            my $self = shift;
242            return join(' ',@{ $self->{dtexts} });
243    }
244    
245  =head2 dump_draft  =head2 dump_draft
246    
247    Dump draft data from document object.
248    
249    print $doc->dump_draft;    print $doc->dump_draft;
250    
251  =cut  =cut
252    
253  sub dump_draft {  sub dump_draft {
254            my $self = shift;
255            my $draft;
256    
257            foreach my $attr_name (sort keys %{ $self->{attrs} }) {
258                    $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
259            }
260    
261            if ($self->{kwords}) {
262                    $draft .= '%%VECTOR';
263                    while (my ($key, $value) = each %{ $self->{kwords} }) {
264                            $draft .= "\t$key\t$value";
265                    }
266                    $draft .= "\n";
267            }
268    
269            $draft .= "\n";
270    
271            $draft .= join("\n", @{ $self->{dtexts} }) . "\n";
272            $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";
273    
274            return $draft;
275  }  }
276    
277  =head2 delete  =head2 delete
# Line 152  Empty document object Line 285  Empty document object
285  sub delete {  sub delete {
286          my $self = shift;          my $self = shift;
287    
288          foreach my $data (qw/attrs dtexts stexts/) {          foreach my $data (qw/attrs dtexts stexts kwords/) {
289                  delete($self->{$data});                  delete($self->{$data});
290          }          }
291    
292            $self->{id} = -1;
293    
294          return 1;          return 1;
295  }  }
296    
Legend:
Removed from v.6  
changed lines
  Added in v.14
  ViewVC Help
Powered by ViewVC 1.1.26