--- lib/Strix.pm	2008/06/16 20:08:28	181
+++ lib/Strix.pm	2008/06/20 21:49:16	216
@@ -11,6 +11,11 @@
 use Carp qw/confess/;
 use Jifty;
 
+use File::Slurp;
+use JSON::XS;
+use Carp qw/confess/;
+use URI::Escape;
+
 our $debug = 0;
 
 =head1 NAME
@@ -32,6 +37,7 @@
 =cut
 
 our $instance_dbh;
+our @instances_active;
 
 sub dbh {
 	my $self = shift;
@@ -52,9 +58,20 @@
 
 	Jifty->log->info("Connect to instance $instance with dsn $dsn");
 
-	my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die $DBI::errstr;
+	my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die "$DBI::errstr\n";
+
+	# force database to send us back UTF-8 no metter what it's encoding
+	$dbh->do("set client_encoding='utf-8'");
+	$dbh->{pg_enable_utf8} = 1;
 
 	$instance_dbh->{$instance} = $dbh;
+	push @instances_active, $instance;
+
+	if ( $#instances_active > 5 ) {
+		my $i = shift @instances_active;
+		warn "## remove connection to instance $instance\n";
+		delete( $instance_dbh->{$i} );
+	}
 
 	warn "## instance_dbh = ",dump( $instance_dbh ) if $debug;
 
@@ -72,13 +89,17 @@
 
 	my $url = shift || confess "no url";
 
+	my $data = $self->read_cache( uri_escape($url) );
+	return $data if $data;
+
 	# sysinc/profiles.php
 	my $sth = $self->dbh->prepare(qq{
 	SELECT kategorija.*, lang.langid, lang.locale, template.tfilename, template.tflags, site.naziv as sitename, site.admin_mail, site.address, site.root as site_root, getPathFromNav(kategorija.id) as path, site.ordstr as site_ordstr FROM kategorija, template, site, lang WHERE kategorija.url = ? AND kategorija.template_id = template.id AND kategorija.site_id = site.id AND lang.id = kategorija.lang
 	});
 	$sth->execute($url);
 
-	my $category = $sth->fetchrow_hashref() or die "can't fetch category $url";
+	my $category = $sth->fetchrow_hashref() or die "can't fetch category $url from instance ",$self->instance,"\n";
+	$self->write_cache( $category, uri_escape($url) );
 	return $category;
 }
 
@@ -93,6 +114,9 @@
 
 	my $url = shift || confess "no url";
 
+	my $data = $self->read_cache( uri_escape($url) );
+	return $data if $data;
+
 	my $dbh = $self->dbh;
 	my $category = $self->category( $url );
 
@@ -167,39 +191,36 @@
 		push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => module_args( $row ) };
 	}
 
+	$self->write_cache( $page, uri_escape($url) );
+
 	return $page;
 
 }
 
-=head2 sitemap
+=head2 sites
 
-	my $sitemap = $strix->sitemap( $site_id, $uid );
+	my @sites = $strix->sites;
 
 =cut
 
-sub sitemap {
+sub sites {
 	my $self = shift;
 
-	my ( $site_id, $uid ) = @_;
-	my $sitemap;
-
-	my $query = "SELECT *, ( length(ordstr)/3 ) - 1 AS depth FROM site WHERE id = ?";
-	$query = "SELECT *, coalesce(( length(ordstr)/3 ) - 1,0) AS depth FROM site ORDER BY ordstr" unless $site_id;
+	my @sites = $self->read_cache;
+	return @sites if @sites;
 
-	my $sth = $self->dbh->prepare( $query );
-	if ( $site_id ) {
-		$sth->execute( $site_id );
-	} else {
-		$sth->execute;
-	}
+	my $sth = $self->dbh->prepare(
+	"SELECT *, coalesce(( length(ordstr)/3 ) - 1,0) AS depth FROM site ORDER BY ordstr"
+	);
+	$sth->execute;
 
 	while (my $row = $sth->fetchrow_hashref() ) {
-		warn dump( $row ) if $debug;
-
-		$sitemap->{ $row->{naziv} } = $self->site_navigation( $site_id, $uid );
+		push @sites, $row;
 	}
 
-	return $sitemap;
+	$self->write_cache( \@sites );
+
+	return @sites;
 }
 
 =head2 site_navigation
@@ -216,6 +237,9 @@
 	$uid ||= 1; # anonymous
 #	$uid ||= 2; # admin
 
+	my $data = $self->read_cache( $site_id, $uid );
+	return $data if $data;
+
 	my $sth = $self->dbh->prepare(
 	"SELECT kategorija.*, ((length(prikaz)+length(coalesce(ordstr,'')))/3)-1 as depth FROM kategorija JOIN navigacija ON (kategorija.id = kategorija_id), site WHERE site_id = ? AND site.id = site_id AND userCanDoOnObject(?, 1, 'kats', kategorija.id) ORDER BY prikaz");
 	$sth->execute( $site_id, $uid );
@@ -228,7 +252,10 @@
 
 	while (my $kat = $sth->fetchrow_hashref() ) {
 		warn "# kat = ",dump( $kat ) if $debug;
-		die "no depth" unless $kat->{depth};
+		if ( ! $kat->{depth} ) {
+			Jifty->log->error("depth increased to 1 in ",dump( $kat ));
+			$kat->{depth} = 1;
+		}
 
 		my $node = { type => 'category' };
 		foreach my $c ( qw/naziv url/ ) {
@@ -236,6 +263,11 @@
 		}
 
 		my $depth = $kat->{depth};
+		if ( ! defined $pos[ $depth - 2 ] ) {
+			warn "FIXING CATEGORY: ",dump( $kat );
+			$node->{class} = "error";
+			$depth--;
+		}
 		@pos = splice( @pos, 0, $depth );
 		$pos[ $depth - 1 ]++;
 
@@ -292,8 +324,67 @@
 
 	}
 
+	$self->write_cache( $navigation, $site_id, $uid );
+
 	return $navigation;
 
 }
 
+=head2 cache_path
+
+Generate unique name for specified values
+
+  my $path = $strix->cache_path( $var, ... );
+
+Variables have to be path-safe (e.g. use C<uri_encode> if needed)
+
+=cut
+
+sub cache_path {
+	my $self = shift;
+
+	#warn "# cache_path",dump( @_ );
+
+	my $path = Jifty::Util->absolute_path( 'var/strix' );
+
+	if ( ! -e $path ) {
+		mkdir $path || die "can't create $path: $!";
+	}
+
+	#warn "## caller = ",dump( (caller(2))[3] );
+	my $uid = (caller(2))[3];
+	$uid =~ s/^[^:]+:://;
+	$uid .= '-' . join('-', @_) if @_;
+	$uid .= '.js';
+
+	return $path . '/' . $self->instance . '-' . $uid;
+}
+
+=head2 write_cache
+
+  write_cache( $data, $key_var, ... );
+
+=cut
+
+sub write_cache {
+	my $self = shift;
+	my $data = shift || confess "no data?";
+	my $path = $self->cache_path( @_ );
+	write_file( $path, encode_json( $data )) || die "can't save into $path: $!";
+}
+
+=head2 read_cache
+
+	my $data = read_cache( 'format-%d', $var ... );
+
+=cut
+
+sub read_cache {
+	my $self = shift;
+	my $path = $self->cache_path( @_ );
+	return unless -e $path;
+	#warn "# read_cache( $path )";
+	return decode_json( read_file( $path ) ) || die "can't read $path: $!";
+}
+
 1;