--- Webpacus/lib/Webpacus/Model/WebPAC.pm	2006/01/22 02:52:24	382
+++ Webpacus/lib/Webpacus/Model/WebPAC.pm	2006/03/19 22:57:05	422
@@ -12,7 +12,6 @@
 use Time::HiRes qw/time/;
 use Encode qw/encode decode from_to/;
 use Template;
-use Data::Dumper;
 
 =head1 NAME
 
@@ -66,7 +65,7 @@
 
 	$est_cfg->{encoding} = $est_cfg->{catalyst_encoding} || $c->config->{catalyst_encoding} or $c->log->fatal("can't find catalyst_encoding");
 
-	$log->debug("using config:" . Dumper($est_cfg) );
+	$log->dumper($est_cfg, 'est_cfg');
 
 	if (! $est_cfg->{database}) {
 		my $defaultnode = $est_cfg->{defaultnode} || $log->logdie("can't find defaultnode in estraier configuration");
@@ -87,7 +86,10 @@
 	$log->fatal("can't create Search::Estraier::Node $url") unless ($self->{est_node});
 
 	# save config parametars in object
-	foreach my $f (qw/db_path template_path hits_on_page webpac_encoding defaultdepth/) {
+	foreach my $f (qw/
+		db_path template_path hits_on_page webpac_encoding defaultdepth
+		masterurl defaultnode
+		/) {
 		$self->{$f} = $c->config->{hyperestraier}->{$f} ||
 			$c->config->{webpac}->{$f};
 		$log->debug("self->{$f} = " . $self->{$f});
@@ -138,6 +140,30 @@
 
 }
 
+=head2 setup_site
+
+ $self->setup_site('site_name');
+
+Change node URL and database name according to site name (if available) or fallback
+to C<defaultnode> from configuration.
+
+=cut
+
+sub setup_site {
+	my $self = shift;
+
+	my $site = shift;
+	if (! $site) {
+		$site = $self->{defaultnode};
+		$self->{log}->warn("using default site $site");
+	}
+
+	$self->{log}->fatal("setup_site can't find site or defaultnode") unless ($site);
+
+	my $url = $self->{masterurl} . '/node/' . $site;
+	$self->{est_node}->set_url( $url );
+	$self->{log}->debug("setup_site '$site' using $url");
+}
 
 =head2 search
 
@@ -165,17 +191,10 @@
 
 	my $log = $self->{log};
 
-	$log->debug("search args: " . Dumper( $args ));
+	$log->dumper($args, 'args');
 
 	my $query = $args->{phrase} || $log->warn("no query phrase") && return;
 
-	$log->debug("search model query: '$query'");
-	if ($args->{add_attr}) {
-		$log->debug(" + add_attr: " .
-			join("','", @{ $args->{add_attr} })
-		);
-	}
-
 	my $template_filename = $args->{template} || $self->{template};
 
 	$args->{max} ||= $self->{'hits_for_pager'};
@@ -194,8 +213,9 @@
 		$args->{depth} = $default;
 		$log->warn("using default search depth $default");
 	}
+	$args->{depth} ||= 0;
 
-	$log->debug("searching for maximum $args->{max} results using depth $args->{depth}");
+	$log->debug("searching " . $self->{est_node}->{url} . " max: $args->{max} depth: $args->{depth} phrase: " . ($query || '[none]') );
 
 	#
 	# construct condition for Hyper Estraier
@@ -204,7 +224,7 @@
 	if ( ref($args->{add_attr}) eq 'ARRAY' ) {
 		$log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
 		map {
-			$cond->add_attr( _convert( $_ ) );
+			$cond->add_attr( $_ );
 			$log->debug(" + $_");
 		} @{ $args->{add_attr} };
 	};
@@ -220,15 +240,22 @@
 		$page = 1;
 	}
 
-	$times->{est} += time() - $t;
-
 	$cond->set_max( $page * $max );
 
-	my $result = $self->{est_node}->search($cond, ( $args->{depth} || 0 ));
+	my $result = $self->{est_node}->search($cond, $args->{depth});
+	if (! $result) {
+		$self->{log}->fatal("search didn't return result");
+		return;
+	}
 	my $hits = $result->doc_num;
 
+	$times->{est} += time() - $t;
+
 	$log->debug( sprintf("search took %.6fs and returned $hits hits.", $times->{est}) );
 
+	$self->{hints} = $result->{hints};
+	#$log->dumper($self->{hints}, 'original hints' );
+
 	#
 	# fetch results
 	#
@@ -282,8 +309,6 @@
 
 			$times->{db} += time() - $t;
 
-			#$log->debug( "ds = " . Dumper( \@html_results ) );
-
 			$t = time();
 
 			my $html = $self->apply(
@@ -306,8 +331,6 @@
 
 	}
 
-	$log->debug( '@results = ' . Dumper( \@results ) );
-
 	$log->debug( sprintf(
 		"duration breakdown: estraier %.6fs, hash %.6fs, store %.6fs, apply %.6fs, decode %.06f, total: %.6fs",
 		$times->{est}, $times->{hash}, $times->{db}, $times->{apply}, $times->{decode}, time() - $search_start_t,
@@ -316,6 +339,52 @@
 	return \@results;
 }
 
+=head2 hints
+
+  my $hints = $m->hints;
+
+Return various useful hints about result
+
+=cut
+
+sub hints {
+	my $self = shift;
+
+	unless ($self->{hints}) {
+		$self->{log}->fatal("no hints found!");
+		return;
+	}
+
+	my $hints;
+
+	while (my ($key,$val) = each %{ $self->{hints} }) {
+
+		#$self->{log}->debug("current hint $key = $val");
+
+		if ($key =~ m/^(?:HITS*|TIME|DOCNUM|WORDNUM)$/) {
+			$hints->{ lc($key) } = $val;
+		} elsif ($key =~ m/^HINT#/) {
+			my ($word,$count) = split(/\t/,$val,2);
+			$hints->{words}->{$word} = $count;
+		} elsif ($key =~ m/^LINK#/) {
+			my ($url,undef,undef,undef,undef,undef,$results) = split(/\t/,$val,7);
+			if ($url =~ m#/node/(.+)$#) {
+				$hints->{node}->{$1} = $results;
+			} else {
+				$self->{log}->debug("url $url doesn't have /node/ in it!");
+			}
+		} else {
+			$self->{log}->debug("unknown hint $key = $val");
+		}
+
+	}
+
+	$self->{log}->dumper($hints, 'model hints' );
+
+	return $hints;
+}
+
+
 =head2 record
 
   my $html = $m->record(
@@ -333,7 +402,7 @@
 
 	my $args = {@_};
 	my $log = $self->{log};
-	$log->debug("record args: " . Dumper( $args ));
+	$log->dumper( $args, 'args' );
 
 	foreach my $f (qw/record_uri template/) {
 		$log->fatal("need $f") unless ($args->{$f});
@@ -367,6 +436,73 @@
 }
 
 
+=head2 list_nodes
+
+  my @nodes = $m->list_nodes( 'site' );
+
+Return all databases which have records for selected site. Returned array of
+hashes has elements C<name> and C<label>.
+
+=cut
+
+my $nodes_list;
+
+sub list_nodes {
+	my $self = shift;
+
+	my $site = shift;
+
+	$self->{log}->debug("list_nodes use site $site");
+
+	$self->setup_site( $site );
+
+	# cache?
+	return @{ $nodes_list->{$site} } if ($nodes_list->{$site} && ref($nodes_list->{$site} eq 'ARRAY'));
+
+	my @nodes;
+
+	if ($self->{est_node}->doc_num > 0) {
+		push @nodes, {
+			name => $self->{est_node}->name,
+			label => $self->{est_node}->label,
+			doc_num => $self->{est_node}->doc_num,
+		}
+	}
+
+	# refresh set info
+	$self->{est_node}->_set_info;
+
+	my $links = $self->{est_node}->links || return @nodes;
+
+	$self->{log}->dumper( $links, 'links' );
+
+	foreach my $link (@{ $links }) {
+		my ($url, $label, $credit) = split(/\t/, $link, 3);
+		if ($url =~ m#/node/(.+)$#) {
+			my $node = $1;
+			$self->setup_site( $node );
+			$self->{est_node}->_set_info;
+			$label = decode('UTF-8', $label);
+			push @nodes, {
+				name => $node,
+				label => $label,
+				doc_num => $self->{est_node}->doc_num,
+			}
+		} else {
+			$self->{log}->warn("can't find node name in link $link");
+		}
+	}
+
+	$self->setup_site( $site );
+	$self->{est_node}->_set_info;
+
+	$self->{log}->dumper( \@nodes, 'nodes' );
+
+	$nodes_list->{$site} = \@nodes;
+
+	return @nodes;
+}
+
 =head2 save_html
 
   $m->save_html( '/full/path/to/file', $content );
@@ -438,6 +574,10 @@
 
 =cut
 
+# Escape <, >, & and ", and to produce valid XML
+my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
+my $escape_re  = join '|' => keys %escape;
+
 sub apply {
 	my $self = shift;
 
@@ -485,9 +625,12 @@
 			if (ref($v) eq 'ARRAY') {
 				if ($#{$v} == 0) {
 					$v = $v->[0];
+					$v =~ s/($escape_re)/$escape{$1}/g;
 				} else {
 					$join = $default_delimiter->{$type} unless defined($join);
-					$v = join($join, @{$v});
+					$v = join($join, map {
+						s/($escape_re)/$escape{$1}/g;
+					} @{$v});
 				}
 			} else {
 				warn("TT filter $type(): field $name values aren't ARRAY, ignoring");
@@ -555,14 +698,14 @@
 
 					my $s;
 					if ($s_el > 0) {
-						$s = $item->{'search'}->[$i] || die "can't find value $i for type search in field $search";
+						$s = $item->{'search'}->[$i] or warn "can't find value $i for type search in field $search";
 					} else {
 						$s = $item->{'search'}->[0];
 					}
 					#$s =~ s/([^\w.-])/sprintf("%%%02X",ord($1))/eg;
 					$s = __quotemeta( $s );
 
-					my $d = $item->{'display'}->[$i] || die "can't find value $i for type display in field $display";
+					my $d = $item->{'display'}->[$i] or warn "can't find value $i for type display in field $display";
 
 					my $template_arg = '';
 					$template_arg = qq{,'$template'} if ($template);