/[webpac2]/trunk/lib/WebPAC/Output/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/WebPAC/Output/Estraier.pm

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

revision 458 by dpavlin, Wed May 10 14:08:15 2006 UTC revision 525 by dpavlin, Mon May 22 18:26:56 2006 UTC
# Line 10  use Encode qw/from_to/; Line 10  use Encode qw/from_to/;
10  use Data::Dumper;  use Data::Dumper;
11  use LWP;  use LWP;
12  use URI::Escape;  use URI::Escape;
13    use List::Util qw/first/;
14    
15  =head1 NAME  =head1 NAME
16    
# Line 17  WebPAC::Output::Estraier - Create Hyper Line 18  WebPAC::Output::Estraier - Create Hyper
18    
19  =head1 VERSION  =head1 VERSION
20    
21  Version 0.11  Version 0.12
22    
23  =cut  =cut
24    
25  our $VERSION = '0.11';  our $VERSION = '0.12';
26    
27  =head1 SYNOPSIS  =head1 SYNOPSIS
28    
# Line 98  sub new { Line 99  sub new {
99          my $url = $self->{masterurl} . '/node/' . $self->{database};          my $url = $self->{masterurl} . '/node/' . $self->{database};
100          $self->{url} = $url;          $self->{url} = $url;
101    
102            $self->{label} ||= "WebPAC $self->{database}";
103    
104          $self->{db} = Search::Estraier::Node->new(          $self->{db} = Search::Estraier::Node->new(
105                  url => $url,                  url => $url,
106                  user => $self->{user},                  user => $self->{user},
107                  passwd => $self->{passwd},                  passwd => $self->{passwd},
108                  debug => $self->{debug},                  debug => $self->{debug},
109                  create => 1,                  create => 1,
110                  label => "WebPAC $self->{database}",                  label => $self->convert( $self->{label} ),
111          );          );
112    
113          $log->info("using index $self->{url} with encoding $self->{encoding}");          $log->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}");
114    
115          if ($self->{clean}) {          if ($self->{clean}) {
116                  $log->debug("clean $self->{database}");                  $log->debug("clean $self->{database}");
# Line 216  sub add_link { Line 219  sub add_link {
219          my $args = {@_};          my $args = {@_};
220          my $log = $self->_get_logger;          my $log = $self->_get_logger;
221    
222          my @labels = $self->master( action => 'nodelist' );          my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );
223    
224          $log->debug("got labels: ", join("|", @labels));          if (! $node) {
225                    $log->warn("can't find node $args->{to}, skipping link creaton");
226                    return;
227            }
228    
229          @labels = grep(/^$args->{to}\t/, @labels);          my $label = $node->{label};
         my $label = shift @labels;  
         (undef,$label) = split(/\t/, $label) if ($label);  
230    
231          if (! $label) {          if (! $label) {
232                  $log->warn("can't find label for $args->{to}, skipping link creaton");                  $log->warn("can't find label for $args->{to}, skipping link creaton");
# Line 231  sub add_link { Line 235  sub add_link {
235    
236          $log->debug("using label $label for $args->{to}");          $log->debug("using label $label for $args->{to}");
237    
238          return $self->estcall(          return $self->{db}->set_link(
239                  validate => 'node',                  $self->{masterurl} . '/node/' . $args->{to},
240                  action => '_set_link',                  $label,
241                  rest_url => $self->{masterurl} . '/node/' . $args->{from} . '/_set_link' ,                  $args->{credit},
                 url => $self->{masterurl} . '/node/' . $args->{to},  
                 label => $label,  
                 credit => $args->{credit},  
242          );          );
243  }  }
244    
Legend:
Removed from v.458  
changed lines
  Added in v.525
  ViewVC Help
Powered by ViewVC 1.1.26