--- Webpacus/lib/Webpacus/Model/WebPAC.pm	2006/02/19 12:37:27	399
+++ 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");
@@ -89,7 +88,7 @@
 	# save config parametars in object
 	foreach my $f (qw/
 		db_path template_path hits_on_page webpac_encoding defaultdepth
-		masterurl
+		masterurl defaultnode
 		/) {
 		$self->{$f} = $c->config->{hyperestraier}->{$f} ||
 			$c->config->{webpac}->{$f};
@@ -145,18 +144,25 @@
 
  $self->setup_site('site_name');
 
-Change node URL and database name according to site name (if available)
+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 || return;
+	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");
+	$self->{log}->debug("setup_site '$site' using $url");
 }
 
 =head2 search
@@ -185,7 +191,7 @@
 
 	my $log = $self->{log};
 
-	$log->debug("search args: " . Dumper( $args ));
+	$log->dumper($args, 'args');
 
 	my $query = $args->{phrase} || $log->warn("no query phrase") && return;
 
@@ -209,7 +215,7 @@
 	}
 	$args->{depth} ||= 0;
 
-	$log->debug("searching for maximum $args->{max} results using depth $args->{depth} phrase: ", $query || '[none]');
+	$log->debug("searching " . $self->{est_node}->{url} . " max: $args->{max} depth: $args->{depth} phrase: " . ($query || '[none]') );
 
 	#
 	# construct condition for Hyper Estraier
@@ -237,13 +243,18 @@
 	$cond->set_max( $page * $max );
 
 	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}) );
 
-	$log->debug( "hints: " . Dumper($result->{hints}) );
+	$self->{hints} = $result->{hints};
+	#$log->dumper($self->{hints}, 'original hints' );
 
 	#
 	# fetch results
@@ -298,8 +309,6 @@
 
 			$times->{db} += time() - $t;
 
-			#$log->debug( "ds = " . Dumper( \@html_results ) );
-
 			$t = time();
 
 			my $html = $self->apply(
@@ -322,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,
@@ -332,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(
@@ -349,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});
@@ -383,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 );
@@ -454,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;
 
@@ -501,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");