/[A3C]/lib/Strix.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 /lib/Strix.pm

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

revision 171 by dpavlin, Mon Jun 16 13:16:57 2008 UTC revision 219 by dpavlin, Sun Jun 22 14:41:23 2008 UTC
# Line 3  package Strix; Line 3  package Strix;
3  use strict;  use strict;
4  use warnings;  use warnings;
5    
6  use base qw(Jifty::Object Class::Accessor::Fast);  use base qw(Jifty::Object Class::Accessor::Fast A3C::Cache);
7  __PACKAGE__->mk_accessors( qw(site uid) );  __PACKAGE__->mk_accessors( qw(instance uid) );
8    
9  use DBI;  use DBI;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11  use Carp qw/confess/;  use Carp qw/confess/;
12    use Jifty;
13    
14    use Carp qw/confess/;
15    use URI::Escape;
16    
17  our $debug = 0;  our $debug = 0;
18    
# Line 20  Strix Line 24  Strix
24    
25  =head2 new  =head2 new
26    
27    my $strix = Strix->new({ site => 'os-test0604-zg' });    my $strix = Strix->new({ instance => 'os-test0604-zg' });
28    
29  =head2 dbh  =head2 dbh
30    
31    my $dbh = Strix->dbh( $site_name );    my $dbh = Strix->dbh( $strix_instance );
32    
33    my $dbh = $strix->dbh;    my $dbh = $strix->dbh;
34    
35  =cut  =cut
36    
37  our $site_dbh;  our $instance_dbh;
38    our @instances_active;
39    
40  sub dbh {  sub dbh {
41          my $self = shift;          my $self = shift;
42    
43          my $site = shift || $self->site || confess "no site";          my $instance = shift || ref($self) && $self->instance || confess "no instance";
44    
45          return $site_dbh->{$site} if $site_dbh->{$site};          return $instance_dbh->{$instance} if $instance_dbh->{$instance};
46    
47          my $config = Jifty->config->app('strix') or die "need strix config";          my $config = Jifty->config->app('strix') or die "need strix config";
48          my $database = $config->{database} or die "no strix.database in config";          my $database = $config->{database} or die "no strix.database in config";
# Line 45  sub dbh { Line 50  sub dbh {
50          Jifty->log->debug("using config ", dump( $database ));          Jifty->log->debug("using config ", dump( $database ));
51    
52          my $dsn =          my $dsn =
53                  'DBI:Pg:dbname=' . $site .                  'DBI:Pg:dbname=' . $instance .
54                  ';host=' . $database->{host} .                  ';host=' . $database->{host} .
55                  ';port=' . $database->{port};                  ';port=' . $database->{port};
56    
57          Jifty->log->info("Connect to site $site with dsn $dsn");          Jifty->log->info("Connect to instance $instance with dsn $dsn");
58    
59            my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die "$DBI::errstr\n";
60    
61          my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die $DBI::errstr;          # force database to send us back UTF-8 no metter what it's encoding
62            $dbh->do("set client_encoding='utf-8'");
63            $dbh->{pg_enable_utf8} = 1;
64    
65          $site_dbh->{$site} = $dbh;          $instance_dbh->{$instance} = $dbh;
66            push @instances_active, $instance;
67    
68          warn "## site_dbh = ",dump( $site_dbh );          if ( $#instances_active > 5 ) {
69                    my $i = shift @instances_active;
70                    warn "## remove connection to instance $instance\n";
71                    delete( $instance_dbh->{$i} );
72            }
73    
74            warn "## instance_dbh = ",dump( $instance_dbh ) if $debug;
75    
76          return $dbh;          return $dbh;
77  }  }
# Line 71  sub category { Line 87  sub category {
87    
88          my $url = shift || confess "no url";          my $url = shift || confess "no url";
89    
90            my $data = $self->read_cache( uri_escape($url) );
91            return $data if $data;
92    
93          # sysinc/profiles.php          # sysinc/profiles.php
94          my $sth = $self->dbh->prepare(qq{          my $sth = $self->dbh->prepare(qq{
95          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          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
96          });          });
97          $sth->execute($url);          $sth->execute($url);
98    
99          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";
100            $self->write_cache( $category, uri_escape($url) );
101          return $category;          return $category;
102  }  }
103    
# Line 92  sub layout { Line 112  sub layout {
112    
113          my $url = shift || confess "no url";          my $url = shift || confess "no url";
114    
115            my $data = $self->read_cache( uri_escape($url) );
116            return $data if $data;
117    
118          my $dbh = $self->dbh;          my $dbh = $self->dbh;
119          my $category = $self->category( $url );          my $category = $self->category( $url );
120    
# Line 116  sub layout { Line 139  sub layout {
139          });          });
140          $sth->execute( $category->{template_id} );          $sth->execute( $category->{template_id} );
141    
142            sub module_args {
143                    my $row = shift;
144                    return undef unless $row->{module_args};
145                    my $args;
146                    foreach my $a ( split(/\&/, $row->{module_args} ) ) {
147                            $args->{$1} = $2 if $a =~ m/^(.+)=(.+)$/;
148                    }
149                    return $args;
150            }
151    
152          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
153                  warn dump( $row ) if $debug;                  warn dump( $row ) if $debug;
154                  push @{ $page->{free} }, { $row->{name} => $row->{module_args} };                  push @{ $page->{free} }, { $row->{name} => module_args( $row ) };
155          }          }
156    
157          warn "### pre layout...\n" if $debug;          warn "### pre layout...\n" if $debug;
# Line 138  sub layout { Line 171  sub layout {
171    
172          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
173                  warn dump( $row ) if $debug;                  warn dump( $row ) if $debug;
174                  push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => $row->{module_args} };                  push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => module_args( $row ) };
175          }          }
176    
177          warn "### post layout...\n" if $debug;          warn "### post layout...\n" if $debug;
# Line 153  sub layout { Line 186  sub layout {
186    
187          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
188                  warn dump( $row ) if $debug;                  warn dump( $row ) if $debug;
189                  push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => $row->{module_args} };                  push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => module_args( $row ) };
190          }          }
191    
192            $self->write_cache( $page, uri_escape($url) );
193    
194          return $page;          return $page;
195    
196  }  }
197    
198  =head2 sitemap  =head2 sites
199    
200          my $sitemap = $strix->sitemap( $site_id, $uid );          my @sites = $strix->sites;
201    
202  =cut  =cut
203    
204  sub sitemap {  sub sites {
205          my $self = shift;          my $self = shift;
206    
207          my ( $site_id, $uid ) = @_;          my @sites = $self->read_cache;
208          my $sitemap;          return @sites if @sites;
   
         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;  
209    
210          my $sth = $self->dbh->prepare( $query );          my $sth = $self->dbh->prepare(
211          if ( $site_id ) {          "SELECT *, coalesce(( length(ordstr)/3 ) - 1,0) AS depth FROM site ORDER BY ordstr"
212                  $sth->execute( $site_id );          );
213          } else {          $sth->execute;
                 $sth->execute;  
         }  
214    
215          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
216                  warn dump( $row ) if $debug;                  push @sites, $row;
   
                 $sitemap->{ $row->{naziv} } = $self->site_navigation( $site_id, $uid );  
217          }          }
218    
219          return $sitemap;          $self->write_cache( \@sites );
220    
221            return @sites;
222  }  }
223    
224  =head2 site_navigation  =head2 site_navigation
# Line 205  sub site_navigation { Line 235  sub site_navigation {
235          $uid ||= 1; # anonymous          $uid ||= 1; # anonymous
236  #       $uid ||= 2; # admin  #       $uid ||= 2; # admin
237    
238            my $data = $self->read_cache( $site_id, $uid );
239            return $data if $data;
240    
241          my $sth = $self->dbh->prepare(          my $sth = $self->dbh->prepare(
242          "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");          "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");
243          $sth->execute( $site_id, $uid );          $sth->execute( $site_id, $uid );
# Line 217  sub site_navigation { Line 250  sub site_navigation {
250    
251          while (my $kat = $sth->fetchrow_hashref() ) {          while (my $kat = $sth->fetchrow_hashref() ) {
252                  warn "# kat = ",dump( $kat ) if $debug;                  warn "# kat = ",dump( $kat ) if $debug;
253                  die "no depth" unless $kat->{depth};                  if ( ! $kat->{depth} ) {
254                            Jifty->log->error("depth increased to 1 in ",dump( $kat ));
255                            $kat->{depth} = 1;
256                    }
257    
258                  my $node = { type => 'category' };                  my $node = { type => 'category' };
259                  foreach my $c ( qw/naziv url/ ) {                  foreach my $c ( qw/naziv url/ ) {
# Line 225  sub site_navigation { Line 261  sub site_navigation {
261                  }                  }
262    
263                  my $depth = $kat->{depth};                  my $depth = $kat->{depth};
264                    if ( ! defined $pos[ $depth - 2 ] ) {
265                            warn "FIXING CATEGORY: ",dump( $kat );
266                            $node->{class} = "error";
267                            $depth--;
268                    }
269                  @pos = splice( @pos, 0, $depth );                  @pos = splice( @pos, 0, $depth );
270                  $pos[ $depth - 1 ]++;                  $pos[ $depth - 1 ]++;
271    
272                  warn "## category depth = $depth pos = ",dump( @pos );                  warn "## category depth = $depth pos = ",dump( @pos ) if $debug;
273    
274                  my $code = '$navigation';                  my $code = '$navigation';
275                  map { $code .= '->[' . ( $_ - 1 ) . ']->{children}' } @pos;                  map { $code .= '->[' . ( $_ - 1 ) . ']->{children}' } @pos;
276                  $code =~ s/->{children}$//;                  $code =~ s/->{children}$//;
277                  warn "## category code: $code\n";                  warn "## category code: $code\n" if $debug;
278                  eval $code . '= $node';                  eval $code . '= $node';
279                  if ( $@ ) {                  if ( $@ ) {
280                          warn "SKIPPED CATEGORY: $@ ",dump( $kat );                          warn "SKIPPED CATEGORY: $@ ",dump( $kat );
# Line 267  sub site_navigation { Line 308  sub site_navigation {
308                                                                    
309                                  my $ms_depth = $ms->{depth} + $depth;                                  my $ms_depth = $ms->{depth} + $depth;
310                                  my $p = $pos[ $ms_depth - 1 ]++;                                  my $p = $pos[ $ms_depth - 1 ]++;
311                                  warn "## multistatic depth = $ms_depth pos = ",dump( @pos );                                  warn "## multistatic depth = $ms_depth pos = ",dump( @pos ) if $debug;
312    
313                                  my $ms_code = $code . '->{children}->[ ' . $p . ']  = $node';                                  my $ms_code = $code . '->{children}->[ ' . $p . ']  = $node';
314                                  warn "## multistatic code: $ms_code\n";                                  warn "## multistatic code: $ms_code\n" if $debug;
315                                  eval $ms_code;                                  eval $ms_code;
316                                  if ( $@ ) {                                  if ( $@ ) {
317                                          warn "SKIPPED MULTISTATIC: $@ ",dump( $ms );                                          warn "SKIPPED MULTISTATIC: $@ ",dump( $ms );
# Line 281  sub site_navigation { Line 322  sub site_navigation {
322    
323          }          }
324    
325            $self->write_cache( $navigation, $site_id, $uid );
326    
327          return $navigation;          return $navigation;
328    
329  }  }
Legend:
Removed from v.171  
changed lines
  Added in v.219
  ViewVC Help
Powered by ViewVC 1.1.26