/[Search-Estraier]/trunk/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/Estraier.pm

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

revision 12 by dpavlin, Wed Jan 4 19:28:30 2006 UTC revision 42 by dpavlin, Thu Jan 5 23:38:32 2006 UTC
# Line 4  use 5.008; Line 4  use 5.008;
4  use strict;  use strict;
5  use warnings;  use warnings;
6    
 require Exporter;  
   
 our @ISA = qw(Exporter);  
   
 our %EXPORT_TAGS = ( 'all' => [ qw(  
 ) ] );  
   
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );  
   
 our @EXPORT = qw(  
 );  
   
7  our $VERSION = '0.00';  our $VERSION = '0.00';
8    
 use Carp;  
   
9  =head1 NAME  =head1 NAME
10    
11  Search::Estraier - pure perl module to use Hyper Estraier search engine  Search::Estraier - pure perl module to use Hyper Estraier search engine
# Line 41  implementation. It also includes methods Line 27  implementation. It also includes methods
27    
28  =cut  =cut
29    
30    =head1 Inheritable common methods
31    
32    This methods should really move somewhere else.
33    
34    =head2 _s
35    
36    Remove multiple whitespaces from string, as well as whitespaces at beginning or end
37    
38     my $text = $self->_s(" this  is a text  ");
39     $text = 'this is a text';
40    
41    =cut
42    
43    sub _s {
44            my $text = $_[1] || return;
45            $text =~ s/\s\s+/ /gs;
46            $text =~ s/^\s+//;
47            $text =~ s/\s+$//;
48            return $text;
49    }
50    
51  package Search::Estraier::Document;  package Search::Estraier::Document;
52    
53  use Carp qw/croak confess/;  use Carp qw/croak confess/;
54    
55    use Search::Estraier;
56    our @ISA = qw/Search::Estraier/;
57    
58  =head1 Search::Estraier::Document  =head1 Search::Estraier::Document
59    
60  Document for HyperEstraier  This class implements Document which is collection of attributes
61    (key=value), vectors (also key value) display text and hidden text.
62    
63    
64  =head2 new  =head2 new
65    
66    Create new document, empty or from draft.
67    
68    my $doc = new Search::HyperEstraier::Document;    my $doc = new Search::HyperEstraier::Document;
69      my $doc2 = new Search::HyperEstraier::Document( $draft );
70    
71  =cut  =cut
72    
73  sub new {  sub new {
74          my $class = shift;          my $class = shift;
75          my $self = {@_};          my $self = {};
76          bless($self, $class);          bless($self, $class);
77    
78          $self->{id} = -1;          $self->{id} = -1;
79    
80            my $draft = shift;
81    
82            if ($draft) {
83                    my $in_text = 0;
84                    foreach my $line (split(/\n/, $draft)) {
85    
86                            if ($in_text) {
87                                    if ($line =~ /^\t/) {
88                                            push @{ $self->{htexts} }, substr($line, 1);
89                                    } else {
90                                            push @{ $self->{dtexts} }, $line;
91                                    }
92                                    next;
93                            }
94    
95                            if ($line =~ m/^%VECTOR\t(.+)$/) {
96                                    my @fields = split(/\t/, $1);
97                                    for my $i ( 0 .. ($#fields - 1) ) {
98                                            $self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
99                                            $i++;
100                                    }
101                                    next;
102                            } elsif ($line =~ m/^%/) {
103                                    # What is this? comment?
104                                    #warn "$line\n";
105                                    next;
106                            } elsif ($line =~ m/^$/) {
107                                    $in_text = 1;
108                                    next;
109                            } elsif ($line =~ m/^(.+)=(.+)$/) {
110                                    $self->{attrs}->{ $1 } = $2;
111                                    next;
112                            }
113    
114                            warn "draft ignored: $line\n";
115                    }
116            }
117    
118          $self ? return $self : return undef;          $self ? return $self : return undef;
119  }  }
120    
# Line 84  sub add_attr { Line 137  sub add_attr {
137    
138          while (my ($name, $value) = each %{ $attrs }) {          while (my ($name, $value) = each %{ $attrs }) {
139                  if (! defined($value)) {                  if (! defined($value)) {
140                          delete( $self->{attrs}->{_s($name)} );                          delete( $self->{attrs}->{ $self->_s($name) } );
141                  } else {                  } else {
142                          $self->{attrs}->{_s($name)} = _s($value);                          $self->{attrs}->{ $self->_s($name) } = $self->_s($value);
143                  }                  }
144          }          }
145    
# Line 107  sub add_text { Line 160  sub add_text {
160          my $text = shift;          my $text = shift;
161          return unless defined($text);          return unless defined($text);
162    
163          push @{ $self->{dtexts} }, _s($text);          push @{ $self->{dtexts} }, $self->_s($text);
164  }  }
165    
166    
# Line 124  sub add_hidden_text { Line 177  sub add_hidden_text {
177          my $text = shift;          my $text = shift;
178          return unless defined($text);          return unless defined($text);
179    
180          push @{ $self->{htexts} }, _s($text);          push @{ $self->{htexts} }, $self->_s($text);
181  }  }
182    
183    
184  =head2 id  =head2 id
185    
186  Get the ID number of document. If the object has never been registred, C<-1> is returned.  Get the ID number of document. If the object has never been registred, C<-1> is returned.
# Line 140  sub id { Line 194  sub id {
194          return $self->{id};          return $self->{id};
195  }  }
196    
197    
198  =head2 attr_names  =head2 attr_names
199    
200  Returns array with attribute names from document object.  Returns array with attribute names from document object.
# Line 185  sub texts { Line 240  sub texts {
240          return @{ $self->{dtexts} };          return @{ $self->{dtexts} };
241  }  }
242    
243    
244  =head2 cat_texts  =head2 cat_texts
245    
246  Return whole text as single scalar.  Return whole text as single scalar.
# Line 198  sub cat_texts { Line 254  sub cat_texts {
254          return join(' ',@{ $self->{dtexts} });          return join(' ',@{ $self->{dtexts} });
255  }  }
256    
257    
258  =head2 dump_draft  =head2 dump_draft
259    
260    Dump draft data from document object.
261    
262    print $doc->dump_draft;    print $doc->dump_draft;
263    
264  =cut  =cut
265    
266  sub dump_draft {  sub dump_draft {
267          return 'FIXME';          my $self = shift;
268            my $draft;
269    
270            foreach my $attr_name (sort keys %{ $self->{attrs} }) {
271                    $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
272            }
273    
274            if ($self->{kwords}) {
275                    $draft .= '%%VECTOR';
276                    while (my ($key, $value) = each %{ $self->{kwords} }) {
277                            $draft .= "\t$key\t$value";
278                    }
279                    $draft .= "\n";
280            }
281    
282            $draft .= "\n";
283    
284            $draft .= join("\n", @{ $self->{dtexts} }) . "\n" if ($self->{dtexts});
285            $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n" if ($self->{htexts});
286    
287            return $draft;
288  }  }
289    
290    
291  =head2 delete  =head2 delete
292    
293  Empty document object  Empty document object
294    
295    $doc->delete;    $doc->delete;
296    
297    This function is addition to original Ruby API, and since it was included in C wrappers it's here as a
298    convinience. Document objects which go out of scope will be destroyed
299    automatically.
300    
301  =cut  =cut
302    
303  sub delete {  sub delete {
304          my $self = shift;          my $self = shift;
305    
306          foreach my $data (qw/attrs dtexts stexts/) {          foreach my $data (qw/attrs dtexts stexts kwords/) {
307                  delete($self->{$data});                  delete($self->{$data});
308          }          }
309    
# Line 229  sub delete { Line 313  sub delete {
313  }  }
314    
315    
 =head2 _s  
316    
317  Remove multiple whitespaces from string, as well as whitespaces at beginning or end  package Search::Estraier::Condition;
318    
319   my $text = _s(" this  is a text  ");  use Carp qw/confess croak/;
320   $text = 'this is a text';  
321    use Search::Estraier;
322    our @ISA = qw/Search::Estraier/;
323    
324    =head1 Search::Estraier::Condition
325    
326    =head2 new
327    
328      my $cond = new Search::HyperEstraier::Condition;
329    
330  =cut  =cut
331    
332  sub _s {  sub new {
333          my $text = shift || return;          my $class = shift;
334          $text =~ s/\s\s+/ /gs;          my $self = {};
335          $text =~ s/^\s+//;          bless($self, $class);
336          $text =~ s/\s+$//;  
337          return $text;          $self->{max} = -1;
338            $self->{options} = 0;
339    
340            $self ? return $self : return undef;
341    }
342    
343    
344    =head2 set_phrase
345    
346      $cond->set_phrase('search phrase');
347    
348    =cut
349    
350    sub set_phrase {
351            my $self = shift;
352            $self->{phrase} = $self->_s( shift );
353  }  }
354    
355    
356    =head2 add_attr
357    
358      $cond->add_attr('@URI STRINC /~dpavlin/');
359    
360    =cut
361    
362  package Search::Estraier::Master;  sub add_attr {
363            my $self = shift;
364            my $attr = shift || return;
365            push @{ $self->{attrs} }, $self->_s( $attr );
366    }
367    
 use Carp;  
368    
369  =head1 Search::Estraier::Master  =head2 set_order
370    
371  Controll node master. This requires user with administration priviledges.    $cond->set_order('@mdate NUMD');
372    
373  =cut  =cut
374    
375  {  sub set_order {
376          package RequestAgent;          my $self = shift;
377          @ISA = qw(LWP::UserAgent);          $self->{order} = shift;
378    }
379    
         sub new {  
                 my $self = LWP::UserAgent::new(@_);  
                 $self->agent("Search-Estraier/$Search::Estraer::VERSION");  
                 $self;  
         }  
380    
381          sub get_basic_credentials {  =head2 set_max
382                  my($self, $realm, $uri) = @_;  
383  #               return ($user, $password);    $cond->set_max(42);
384          }  
385    =cut
386    
387    sub set_max {
388            my $self = shift;
389            my $max = shift;
390            croak "set_max needs number" unless ($max =~ m/^\d+$/);
391            $self->{max} = $max;
392  }  }
393    
394    
395    =head2 set_options
396    
397      $cond->set_options( SURE => 1 );
398    
399    =cut
400    
401    my $options = {
402            # check N-gram keys skipping by three
403            SURE => 1 << 0,
404            # check N-gram keys skipping by two
405            USUAL => 1 << 1,
406            # without TF-IDF tuning
407            FAST => 1 << 2,
408            # with the simplified phrase
409            AGITO => 1 << 3,
410            # check every N-gram key
411            NOIDF => 1 << 4,
412            # check N-gram keys skipping by one
413            SIMPLE => 1 << 10,
414    };
415    
416    sub set_options {
417            my $self = shift;
418            my $option = shift;
419            confess "unknown option" unless ($options->{$option});
420            $self->{options} ||= $options->{$option};
421    }
422    
423    
424    =head2 phrase
425    
426    Return search phrase.
427    
428      print $cond->phrase;
429    
430    =cut
431    
432    sub phrase {
433            my $self = shift;
434            return $self->{phrase};
435    }
436    
437    
438    =head2 order
439    
440    Return search result order.
441    
442      print $cond->order;
443    
444    =cut
445    
446    sub order {
447            my $self = shift;
448            return $self->{order};
449    }
450    
451    
452    =head2 attrs
453    
454    Return search result attrs.
455    
456      my @cond_attrs = $cond->attrs;
457    
458    =cut
459    
460    sub attrs {
461            my $self = shift;
462            #croak "attrs return array, not scalar" if (! wantarray);
463            return @{ $self->{attrs} };
464    }
465    
466    
467    =head2 max
468    
469    Return maximum number of results.
470    
471      print $cond->max;
472    
473    C<-1> is returned for unitialized value, C<0> is unlimited.
474    
475    =cut
476    
477    sub max {
478            my $self = shift;
479            return $self->{max};
480    }
481    
482    
483    =head2 options
484    
485    Return options for this condition.
486    
487      print $cond->options;
488    
489    Options are returned in numerical form.
490    
491    =cut
492    
493    sub options {
494            my $self = shift;
495            return $self->{options};
496    }
497    
498    
499    package Search::Estraier::ResultDocument;
500    
501    use Carp qw/croak/;
502    
503    #use Search::Estraier;
504    #our @ISA = qw/Search::Estraier/;
505    
506    =head1 Search::Estraier::ResultDocument
507    
508  =head2 new  =head2 new
509    
510  Create new connection to node master.    my $rdoc = new Search::HyperEstraier::ResultDocument(
511            uri => 'http://localhost/document/uri/42',
512            attrs => {
513                    foo => 1,
514                    bar => 2,
515            },
516            snippet => 'this is a text of snippet'
517            keywords => 'this\tare\tkeywords'
518      );
519    
520    =cut
521    
522    sub new {
523            my $class = shift;
524            my $self = {@_};
525            bless($self, $class);
526    
527            foreach my $f (qw/uri attrs snippet keywords/) {
528                    croak "missing $f for ResultDocument" unless defined($self->{$f});
529            }
530    
531            $self ? return $self : return undef;
532    }
533    
534    
535    =head2 uri
536    
537    Return URI of result document
538    
539      print $rdoc->uri;
540    
541    =cut
542    
543    sub uri {
544            my $self = shift;
545            return $self->{uri};
546    }
547    
548    
549    =head2 attr_names
550    
551    Returns array with attribute names from result document object.
552    
553      my @attrs = $rdoc->attr_names;
554    
555    =cut
556    
557    sub attr_names {
558            my $self = shift;
559            croak "attr_names return array, not scalar" if (! wantarray);
560            return sort keys %{ $self->{attrs} };
561    }
562    
563    
564    =head2 attr
565    
566    Returns value of an attribute.
567    
568      my $value = $rdoc->attr( 'attribute' );
569    
570    =cut
571    
572    sub attr {
573            my $self = shift;
574            my $name = shift || return;
575            return $self->{attrs}->{ $name };
576    }
577    
578    
579    =head2 snippet
580    
581    Return snippet from result document
582    
583      print $rdoc->snippet;
584    
585    =cut
586    
587    sub snippet {
588            my $self = shift;
589            return $self->{snippet};
590    }
591    
592    
593    =head2 keywords
594    
595    Return keywords from result document
596    
597      print $rdoc->keywords;
598    
599    =cut
600    
601    sub keywords {
602            my $self = shift;
603            return $self->{keywords};
604    }
605    
606    
607    package Search::Estraier::NodeResult;
608    
609    use Carp qw/croak/;
610    
611    my $master = new Search::Estraier::Master(  #use Search::Estraier;
612          url => 'http://localhost:1978',  #our @ISA = qw/Search::Estraier/;
613          user => 'admin',  
614          passwd => 'admin',  =head1 Search::Estraier::NodeResult
615    
616    =head2 new
617    
618      my $res = new Search::HyperEstraier::NodeResult(
619            docs => @array_of_rdocs,
620            hits => %hash_with_hints,
621    );    );
622    
623  =cut  =cut
# Line 293  sub new { Line 627  sub new {
627          my $self = {@_};          my $self = {@_};
628          bless($self, $class);          bless($self, $class);
629    
630          foreach my $p (qw/url user passwd/) {          foreach my $f (qw/docs hints/) {
631                  croak "need $p" unless ($self->{$p});                  croak "missing $f for ResultDocument" unless defined($self->{$f});
632          }          }
633    
634          $self ? return $self : return undef;          $self ? return $self : return undef;
635  }  }
636    
637    
638    =head2 doc_num
639    
640    Return number of documents
641    
642      print $res->doc_num;
643    
644    =cut
645    
646    sub doc_num {
647            my $self = shift;
648            return $#{$self->{docs}};
649    }
650    
651    
652    =head2 get_doc
653    
654    Return single document
655    
656      my $doc = $res->get_doc( 42 );
657    
658    Returns undef if document doesn't exist.
659    
660    =cut
661    
662    sub get_doc {
663            my $self = shift;
664            my $num = shift;
665            croak "expect number as argument" unless ($num =~ m/^\d+$/);
666            return undef if ($num < 0 || $num > $self->{docs});
667            return $self->{docs}->[$num];
668    }
669    
670    
671    =head2 hint
672    
673    Return specific hint from results.
674    
675      print $rec->hint( 'VERSION' );
676    
677    Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,
678    C<TIME>, C<LINK#n>, C<VIEW>.
679    
680    =cut
681    
682    sub hint {
683            my $self = shift;
684            my $key = shift || return;
685            return $self->{hints}->{$key};
686    }
687    
688    
689    package Search::Estraier::Node;
690    
691    use Carp qw/carp croak/;
692    use URI;
693    use MIME::Base64;
694    use IO::Socket::INET;
695    
696    =head1 Search::Estraier::Node
697    
698    =head2 new
699    
700      my $node = new Search::HyperEstraier::Node;
701    
702    =cut
703    
704    sub new {
705            my $class = shift;
706            my $self = {
707                    pxport => -1,
708                    timeout => 0,   # this used to be -1
709                    dnum => -1,
710                    wnum => -1,
711                    size => -1.0,
712                    wwidth => 480,
713                    hwidth => 96,
714                    awidth => 96,
715                    status => -1,
716            };
717            bless($self, $class);
718    
719            if (@_) {
720                    $self->{debug} = shift;
721                    warn "## Node debug on\n";
722            }
723    
724            $self ? return $self : return undef;
725    }
726    
727    
728    =head2 set_url
729    
730    Specify URL to node server
731    
732      $node->set_url('http://localhost:1978');
733    
734    =cut
735    
736    sub set_url {
737            my $self = shift;
738            $self->{url} = shift;
739    }
740    
741    
742    =head2 set_proxy
743    
744    Specify proxy server to connect to node server
745    
746      $node->set_proxy('proxy.example.com', 8080);
747    
748    =cut
749    
750    sub set_proxy {
751            my $self = shift;
752            my ($host,$port) = @_;
753            croak "proxy port must be number" unless ($port =~ m/^\d+$/);
754            $self->{pxhost} = $host;
755            $self->{pxport} = $port;
756    }
757    
758    
759    =head2 set_timeout
760    
761    Specify timeout of connection in seconds
762    
763      $node->set_timeout( 15 );
764    
765    =cut
766    
767    sub set_timeout {
768            my $self = shift;
769            my $sec = shift;
770            croak "timeout must be number" unless ($sec =~ m/^\d+$/);
771            $self->{timeout} = $sec;
772    }
773    
774    
775    =head2 set_auth
776    
777    Specify name and password for authentication to node server.
778    
779      $node->set_auth('clint','eastwood');
780    
781    =cut
782    
783    sub set_auth {
784            my $self = shift;
785            my ($login,$passwd) = @_;
786            my $basic_auth = encode_base64( "$login:$passwd" );
787            chomp($basic_auth);
788            $self->{auth} = $basic_auth;
789    }
790    
791    
792    =head2 status
793    
794    Return status code of last request.
795    
796      print $node->status;
797    
798    C<-1> means connection failure.
799    
800    =cut
801    
802    sub status {
803            my $self = shift;
804            return $self->{status};
805    }
806    
807    
808    =head2 put_doc
809    
810    Add a document
811    
812      $node->put_doc( $document_draft ) or die "can't add document";
813    
814    Return true on success or false on failture.
815    
816    =cut
817    
818    sub put_doc {
819            my $self = shift;
820            my $doc = shift || return;
821            return unless ($self->{url});
822            $self->shuttle_url( $self->{url} . '/put_doc',
823                    'text/x-estraier-draft',
824                    $doc->dump_draft,
825                    undef
826            ) == 200;
827    }
828    
829    
830    =head2 out_doc
831    
832    Remove a document
833    
834      $node->out_doc( document_id ) or "can't remove document";
835    
836    Return true on success or false on failture.
837    
838    =cut
839    
840    sub out_doc {
841            my $self = shift;
842            my $id = shift || return;
843            return unless ($self->{url});
844            croak "id must be number" unless ($id =~ m/^\d+$/);
845            $self->shuttle_url( $self->{url} . '/out_doc',
846                    'application/x-www-form-urlencoded',
847                    "id=$id",
848                    undef
849            ) == 200;
850    }
851    
852    
853    =head2 out_doc_by_uri
854    
855    Remove a registrated document using it's uri
856    
857      $node->out_doc_by_uri( 'file:///document_url' ) or "can't remove document";
858    
859    Return true on success or false on failture.
860    
861    =cut
862    
863    sub out_doc_by_uri {
864            my $self = shift;
865            my $uri = shift || return;
866            return unless ($self->{url});
867            $self->shuttle_url( $self->{url} . '/out_doc',
868                    'application/x-www-form-urlencoded',
869                    "uri=$uri",
870                    undef
871            ) == 200;
872    }
873    
874    
875    =head2 edit_doc
876    
877    Edit attributes of a document
878    
879      $node->edit_doc( $document_draft ) or die "can't edit document";
880    
881    Return true on success or false on failture.
882    
883    =cut
884    
885    sub edit_doc {
886            my $self = shift;
887            my $doc = shift || return;
888            return unless ($self->{url});
889            $self->shuttle_url( $self->{url} . '/edit_doc',
890                    'text/x-estraier-draft',
891                    $doc->dump_draft,
892                    undef
893            ) == 200;
894    }
895    
896    
897    =head2 shuttle_url
898    
899    This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node
900    master.
901    
902      my $rv = shuttle_url( $url, $content_type, \$req_body, \$resbody );
903    
904    C<$resheads> and C<$resbody> booleans controll if response headers and/or response
905    body will be saved within object.
906    
907    =cut
908    
909    sub shuttle_url {
910            my $self = shift;
911    
912            my ($url, $content_type, $reqbody, $resbody) = @_;
913    
914            $self->{status} = -1;
915    
916            warn "## $url\n" if ($self->{debug});
917    
918            $url = new URI($url);
919            if (
920                            !$url || !$url->scheme || !$url->scheme eq 'http' ||
921                            !$url->host || !$url->port || $url->port < 1
922                    ) {
923                    carp "can't parse $url\n";
924                    return -1;
925            }
926    
927            my ($host,$port,$query) = ($url->host, $url->port, $url->path);
928    
929            if ($self->{pxhost}) {
930                    ($host,$port) = ($self->{pxhost}, $self->{pxport});
931                    $query = "http://$host:$port/$query";
932            }
933    
934            $query .= '?' . $url->query if ($url->query && ! $reqbody);
935    
936            my $headers;
937    
938            if ($reqbody) {
939                    $headers .= "POST $query HTTP/1.0\r\n";
940            } else {
941                    $headers .= "GET $query HTTP/1.0\r\n";
942            }
943    
944            $headers .= "Host: " . $url->host . ":" . $url->port . "\r\n";
945            $headers .= "Connection: close\r\n";
946            $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
947            $headers .= "Content-Type: $content_type\r\n";
948            $headers .= "Authorization: Basic $self->{auth}\r\n";
949            my $len = 0;
950            {
951                    use bytes;
952                    $len = length($reqbody) if ($reqbody);
953            }
954            $headers .= "Content-Length: $len\r\n";
955            $headers .= "\r\n";
956    
957            my $sock = IO::Socket::INET->new(
958                    PeerAddr        => $host,
959                    PeerPort        => $port,
960                    Proto           => 'tcp',
961                    Timeout         => $self->{timeout} || 90,
962            );
963    
964            if (! $sock) {
965                    carp "can't open socket to $host:$port";
966                    return -1;
967            }
968    
969            warn $headers if ($self->{debug});
970    
971            print $sock $headers or
972                    carp "can't send headers to network:\n$headers\n" and return -1;
973    
974            if ($reqbody) {
975                    warn "$reqbody\n" if ($self->{debug});
976                    print $sock $reqbody or
977                            carp "can't send request body to network:\n$$reqbody\n" and return -1;
978            }
979    
980            my $line = <$sock>;
981            chomp($line);
982            my ($schema, $res_status, undef) = split(/  */, $line, 3);
983            return if ($schema !~ /^HTTP/ || ! $res_status);
984    
985            $self->{status} = $res_status;
986            warn "## response status: $res_status\n" if ($self->{debug});
987    
988            # skip rest of headers
989            $line = <$sock>;
990            while ($line) {
991                    $line = <$sock>;
992                    $line =~ s/[\r\n]+$//;
993                    warn "## ", $line || 'NULL', " ##\n" if ($self->{debug});
994            };
995    
996            # read body
997            $len = 0;
998            do {
999                    $len = read($sock, my $buf, 8192);
1000                    $$resbody .= $buf if ($resbody);
1001            } while ($len);
1002    
1003            warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug});
1004    
1005            return $self->{status};
1006    }
1007    
1008  ###  ###
1009    
# Line 321  Dobrica Pavlinusic, E<lt>dpavlin@rot13.o Line 1024  Dobrica Pavlinusic, E<lt>dpavlin@rot13.o
1024    
1025  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
1026    
1027  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005-2006 by Dobrica Pavlinusic
1028    
1029  This library is free software; you can redistribute it and/or modify  This library is free software; you can redistribute it and/or modify
1030  it under the GPL v2 or later.  it under the GPL v2 or later.
Legend:
Removed from v.12  
changed lines
  Added in v.42
  ViewVC Help
Powered by ViewVC 1.1.26