/[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 168 by dpavlin, Sun Jun 15 23:59:51 2008 UTC revision 216 by dpavlin, Fri Jun 20 21:49:16 2008 UTC
# Line 4  use strict; Line 4  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);
7  __PACKAGE__->mk_accessors( qw(site) );  __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 File::Slurp;
15    use JSON::XS;
16    use Carp qw/confess/;
17    use URI::Escape;
18    
19  our $debug = 0;  our $debug = 0;
20    
# Line 20  Strix Line 26  Strix
26    
27  =head2 new  =head2 new
28    
29    my $strix = Strix->new({ site => 'os-test0604-zg' });    my $strix = Strix->new({ instance => 'os-test0604-zg' });
30    
31  =head2 dbh  =head2 dbh
32    
33    my $dbh = Strix->dbh( $site_name );    my $dbh = Strix->dbh( $strix_instance );
34    
35    my $dbh = $strix->dbh;    my $dbh = $strix->dbh;
36    
37  =cut  =cut
38    
39    our $instance_dbh;
40    our @instances_active;
41    
42  sub dbh {  sub dbh {
43          my $self = shift;          my $self = shift;
44    
45          my $site = shift || $self->site || confess "no site";          my $instance = shift || ref($self) && $self->instance || confess "no instance";
46    
47            return $instance_dbh->{$instance} if $instance_dbh->{$instance};
48    
49          my $config = Jifty->config->app('strix') or die "need strix config";          my $config = Jifty->config->app('strix') or die "need strix config";
50          my $database = $config->{database} or die "no strix.database in config";          my $database = $config->{database} or die "no strix.database in config";
# Line 41  sub dbh { Line 52  sub dbh {
52          Jifty->log->debug("using config ", dump( $database ));          Jifty->log->debug("using config ", dump( $database ));
53    
54          my $dsn =          my $dsn =
55                  'DBI:Pg:dbname=' . $site .                  'DBI:Pg:dbname=' . $instance .
56                  ';host=' . $database->{host} .                  ';host=' . $database->{host} .
57                  ';port=' . $database->{port};                  ';port=' . $database->{port};
58    
59          Jifty->log->info("Connect to site $site with dsn $dsn");          Jifty->log->info("Connect to instance $instance with dsn $dsn");
60    
61            my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die "$DBI::errstr\n";
62    
63          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
64            $dbh->do("set client_encoding='utf-8'");
65            $dbh->{pg_enable_utf8} = 1;
66    
67            $instance_dbh->{$instance} = $dbh;
68            push @instances_active, $instance;
69    
70            if ( $#instances_active > 5 ) {
71                    my $i = shift @instances_active;
72                    warn "## remove connection to instance $instance\n";
73                    delete( $instance_dbh->{$i} );
74            }
75    
76            warn "## instance_dbh = ",dump( $instance_dbh ) if $debug;
77    
78          return $dbh;          return $dbh;
79  }  }
# Line 63  sub category { Line 89  sub category {
89    
90          my $url = shift || confess "no url";          my $url = shift || confess "no url";
91    
92            my $data = $self->read_cache( uri_escape($url) );
93            return $data if $data;
94    
95          # sysinc/profiles.php          # sysinc/profiles.php
96          my $sth = $self->dbh->prepare(qq{          my $sth = $self->dbh->prepare(qq{
97          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
98          });          });
99          $sth->execute($url);          $sth->execute($url);
100    
101          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";
102            $self->write_cache( $category, uri_escape($url) );
103          return $category;          return $category;
104  }  }
105    
# Line 84  sub layout { Line 114  sub layout {
114    
115          my $url = shift || confess "no url";          my $url = shift || confess "no url";
116    
117            my $data = $self->read_cache( uri_escape($url) );
118            return $data if $data;
119    
120          my $dbh = $self->dbh;          my $dbh = $self->dbh;
121          my $category = $self->category( $url );          my $category = $self->category( $url );
122    
# Line 108  sub layout { Line 141  sub layout {
141          });          });
142          $sth->execute( $category->{template_id} );          $sth->execute( $category->{template_id} );
143    
144            sub module_args {
145                    my $row = shift;
146                    return undef unless $row->{module_args};
147                    my $args;
148                    foreach my $a ( split(/\&/, $row->{module_args} ) ) {
149                            $args->{$1} = $2 if $a =~ m/^(.+)=(.+)$/;
150                    }
151                    return $args;
152            }
153    
154          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
155                  warn dump( $row ) if $debug;                  warn dump( $row ) if $debug;
156                  push @{ $page->{free} }, { $row->{name} => $row->{module_args} };                  push @{ $page->{free} }, { $row->{name} => module_args( $row ) };
157          }          }
158    
159          warn "### pre layout...\n" if $debug;          warn "### pre layout...\n" if $debug;
# Line 130  sub layout { Line 173  sub layout {
173    
174          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
175                  warn dump( $row ) if $debug;                  warn dump( $row ) if $debug;
176                  push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => $row->{module_args} };                  push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => module_args( $row ) };
177          }          }
178    
179          warn "### post layout...\n" if $debug;          warn "### post layout...\n" if $debug;
# Line 145  sub layout { Line 188  sub layout {
188    
189          while (my $row = $sth->fetchrow_hashref() ) {          while (my $row = $sth->fetchrow_hashref() ) {
190                  warn dump( $row ) if $debug;                  warn dump( $row ) if $debug;
191                  push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => $row->{module_args} };                  push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => module_args( $row ) };
192          }          }
193    
194            $self->write_cache( $page, uri_escape($url) );
195    
196          return $page;          return $page;
197    
198  }  }
199    
200    =head2 sites
201    
202            my @sites = $strix->sites;
203    
204    =cut
205    
206    sub sites {
207            my $self = shift;
208    
209            my @sites = $self->read_cache;
210            return @sites if @sites;
211    
212            my $sth = $self->dbh->prepare(
213            "SELECT *, coalesce(( length(ordstr)/3 ) - 1,0) AS depth FROM site ORDER BY ordstr"
214            );
215            $sth->execute;
216    
217            while (my $row = $sth->fetchrow_hashref() ) {
218                    push @sites, $row;
219            }
220    
221            $self->write_cache( \@sites );
222    
223            return @sites;
224    }
225    
226    =head2 site_navigation
227    
228      my $navigation = $strix->site_navigation( $site_id, $uid );
229    
230    =cut
231    
232    sub site_navigation {
233            my $self = shift;
234    
235            my ( $site_id, $uid ) = @_;
236    
237            $uid ||= 1; # anonymous
238    #       $uid ||= 2; # admin
239    
240            my $data = $self->read_cache( $site_id, $uid );
241            return $data if $data;
242    
243            my $sth = $self->dbh->prepare(
244            "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");
245            $sth->execute( $site_id, $uid );
246    
247            Jifty->log->debug("site $site_id has ", $sth->rows, " categories for uid $uid");
248    
249            my $navigation = [];
250    
251            my @pos = ( 0 );
252    
253            while (my $kat = $sth->fetchrow_hashref() ) {
254                    warn "# kat = ",dump( $kat ) if $debug;
255                    if ( ! $kat->{depth} ) {
256                            Jifty->log->error("depth increased to 1 in ",dump( $kat ));
257                            $kat->{depth} = 1;
258                    }
259    
260                    my $node = { type => 'category' };
261                    foreach my $c ( qw/naziv url/ ) {
262                            $node->{$c} = $kat->{$c};
263                    }
264    
265                    my $depth = $kat->{depth};
266                    if ( ! defined $pos[ $depth - 2 ] ) {
267                            warn "FIXING CATEGORY: ",dump( $kat );
268                            $node->{class} = "error";
269                            $depth--;
270                    }
271                    @pos = splice( @pos, 0, $depth );
272                    $pos[ $depth - 1 ]++;
273    
274                    warn "## category depth = $depth pos = ",dump( @pos ) if $debug;
275    
276                    my $code = '$navigation';
277                    map { $code .= '->[' . ( $_ - 1 ) . ']->{children}' } @pos;
278                    $code =~ s/->{children}$//;
279                    warn "## category code: $code\n" if $debug;
280                    eval $code . '= $node';
281                    if ( $@ ) {
282                            warn "SKIPPED CATEGORY: $@ ",dump( $kat );
283                            next;
284                    }
285    
286                    my $sth_ms = $self->dbh->prepare(
287                    "SELECT
288                            multistatic.id, multistatic.title, multistatic.kname,
289                            multistatic_navigation.kategorija_id, multistatic_navigation.prikaz,
290                            (LENGTH(multistatic_navigation.prikaz)/3) AS depth
291                    FROM multistatic, multistatic_navigation
292                    WHERE multistatic.id = multistatic_navigation.multistatic_id
293                            AND multistatic_navigation.prikaz != ''
294                            AND multistatic_navigation.kategorija_id = ?
295                            AND multistatic.title != ''
296                    ORDER BY multistatic_navigation.prikaz");
297                    $sth_ms->execute( $kat->{id} );
298    
299                    if ( my $rows = $sth_ms->rows ) {
300                            Jifty->log->debug("$site_id has $rows multistatic pages");
301    
302                            while (my $ms = $sth_ms->fetchrow_hashref() ) {
303                                    warn "# ms = ",dump( $ms ) if $debug;
304    
305                                    my $node = {
306                                            naziv => $ms->{title},
307                                            url => $kat->{url} . '?ms_nav=' . $ms->{prikaz},
308                                            type => 'multistatic',
309                                    };
310                                    
311                                    my $ms_depth = $ms->{depth} + $depth;
312                                    my $p = $pos[ $ms_depth - 1 ]++;
313                                    warn "## multistatic depth = $ms_depth pos = ",dump( @pos ) if $debug;
314    
315                                    my $ms_code = $code . '->{children}->[ ' . $p . ']  = $node';
316                                    warn "## multistatic code: $ms_code\n" if $debug;
317                                    eval $ms_code;
318                                    if ( $@ ) {
319                                            warn "SKIPPED MULTISTATIC: $@ ",dump( $ms );
320                                            next;
321                                    }
322                            }
323                    }
324    
325            }
326    
327            $self->write_cache( $navigation, $site_id, $uid );
328    
329            return $navigation;
330    
331    }
332    
333    =head2 cache_path
334    
335    Generate unique name for specified values
336    
337      my $path = $strix->cache_path( $var, ... );
338    
339    Variables have to be path-safe (e.g. use C<uri_encode> if needed)
340    
341    =cut
342    
343    sub cache_path {
344            my $self = shift;
345    
346            #warn "# cache_path",dump( @_ );
347    
348            my $path = Jifty::Util->absolute_path( 'var/strix' );
349    
350            if ( ! -e $path ) {
351                    mkdir $path || die "can't create $path: $!";
352            }
353    
354            #warn "## caller = ",dump( (caller(2))[3] );
355            my $uid = (caller(2))[3];
356            $uid =~ s/^[^:]+:://;
357            $uid .= '-' . join('-', @_) if @_;
358            $uid .= '.js';
359    
360            return $path . '/' . $self->instance . '-' . $uid;
361    }
362    
363    =head2 write_cache
364    
365      write_cache( $data, $key_var, ... );
366    
367    =cut
368    
369    sub write_cache {
370            my $self = shift;
371            my $data = shift || confess "no data?";
372            my $path = $self->cache_path( @_ );
373            write_file( $path, encode_json( $data )) || die "can't save into $path: $!";
374    }
375    
376    =head2 read_cache
377    
378            my $data = read_cache( 'format-%d', $var ... );
379    
380    =cut
381    
382    sub read_cache {
383            my $self = shift;
384            my $path = $self->cache_path( @_ );
385            return unless -e $path;
386            #warn "# read_cache( $path )";
387            return decode_json( read_file( $path ) ) || die "can't read $path: $!";
388    }
389    
390  1;  1;
Legend:
Removed from v.168  
changed lines
  Added in v.216
  ViewVC Help
Powered by ViewVC 1.1.26