/[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 167 by dpavlin, Sun Jun 15 23:19:02 2008 UTC revision 213 by dpavlin, Fri Jun 20 20:44:18 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/;  use base qw(Jifty::Object Class::Accessor::Fast);
7    __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/;
12    use Jifty;
13    
14    use File::Slurp;
15    use JSON::XS;
16    use Carp qw/confess/;
17    
18    our $debug = 0;
19    
20  =head1 NAME  =head1 NAME
21    
# Line 14  Strix Line 23  Strix
23    
24  =head1 METHODS  =head1 METHODS
25    
26    =head2 new
27    
28      my $strix = Strix->new({ instance => 'os-test0604-zg' });
29    
30  =head2 dbh  =head2 dbh
31    
32          my $dbh = Strix->dbh( $site_name );    my $dbh = Strix->dbh( $strix_instance );
33    
34      my $dbh = $strix->dbh;
35    
36  =cut  =cut
37    
38    our $instance_dbh;
39    our @instances_active;
40    
41  sub dbh {  sub dbh {
42          my $self = shift;          my $self = shift;
43    
44          my $site = shift or die "no site?";          my $instance = shift || ref($self) && $self->instance || confess "no instance";
45    
46            return $instance_dbh->{$instance} if $instance_dbh->{$instance};
47    
48          my $config = Jifty->config->app('strix') or die "need strix config";          my $config = Jifty->config->app('strix') or die "need strix config";
49          my $database = $config->{database} or die "no strix.database in config";          my $database = $config->{database} or die "no strix.database in config";
# Line 31  sub dbh { Line 51  sub dbh {
51          Jifty->log->debug("using config ", dump( $database ));          Jifty->log->debug("using config ", dump( $database ));
52    
53          my $dsn =          my $dsn =
54                  'DBI:Pg:dbname=' . $site .                  'DBI:Pg:dbname=' . $instance .
55                  ';host=' . $database->{host} .                  ';host=' . $database->{host} .
56                  ';port=' . $database->{port};                  ';port=' . $database->{port};
57    
58          Jifty->log->info("Connect to site $site with dsn $dsn");          Jifty->log->info("Connect to instance $instance with dsn $dsn");
59    
60            my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die "$DBI::errstr\n";
61    
62            # force database to send us back UTF-8 no metter what it's encoding
63            $dbh->do("set client_encoding='utf-8'");
64            $dbh->{pg_enable_utf8} = 1;
65    
66            $instance_dbh->{$instance} = $dbh;
67            push @instances_active, $instance;
68    
69            if ( $#instances_active > 5 ) {
70                    my $i = shift @instances_active;
71                    warn "## remove connection to instance $instance\n";
72                    delete( $instance_dbh->{$i} );
73            }
74    
75          my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die $DBI::errstr;          warn "## instance_dbh = ",dump( $instance_dbh ) if $debug;
76    
77          return $dbh;          return $dbh;
78  }  }
79    
80    =head2 category
81    
82            my $category = Strix->category( $url );
83    
84    =cut
85    
86    sub category {
87            my $self = shift;
88    
89            my $url = shift || confess "no url";
90    
91            # sysinc/profiles.php
92            my $sth = $self->dbh->prepare(qq{
93            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
94            });
95            $sth->execute($url);
96    
97            my $category = $sth->fetchrow_hashref() or die "can't fetch category $url";
98            return $category;
99    }
100    
101    =head2 layout
102    
103            my $layout = $strix->layout( $url );
104    
105    =cut
106    
107    sub layout {
108            my $self = shift;
109    
110            my $url = shift || confess "no url";
111    
112            my $dbh = $self->dbh;
113            my $category = $self->category( $url );
114    
115            my $sth = $dbh->prepare(qq{
116            SELECT template.tfilename, template.tflags FROM template WHERE id = ?
117            });
118            $sth->execute( $category->{template_id} );
119    
120            my $template = $sth->fetchrow_hashref() or die "can't fetch template";
121    
122            warn "template = ",dump( $template ) if $debug;
123    
124            my $page;
125            warn "### free layout...\n" if $debug;
126    
127            # index.php
128            $sth = $dbh->prepare(qq{
129            SELECT layout_id, module_id, pozicija, module_args, name, fname, notitle, class_name
130            FROM pre_layout, modules
131            WHERE id=module_id AND ? = template_id AND redoslijed >= 0
132            ORDER BY redoslijed DESC
133            });
134            $sth->execute( $category->{template_id} );
135    
136            sub module_args {
137                    my $row = shift;
138                    return undef unless $row->{module_args};
139                    my $args;
140                    foreach my $a ( split(/\&/, $row->{module_args} ) ) {
141                            $args->{$1} = $2 if $a =~ m/^(.+)=(.+)$/;
142                    }
143                    return $args;
144            }
145    
146            while (my $row = $sth->fetchrow_hashref() ) {
147                    warn dump( $row ) if $debug;
148                    push @{ $page->{free} }, { $row->{name} => module_args( $row ) };
149            }
150    
151            warn "### pre layout...\n" if $debug;
152    
153            $sth = $dbh->prepare(qq{
154            SELECT
155                    l.id as layout_id, l.user_id, l.kategorija_id, l.module_id, l.pozicija, l.redoslijed, l.module_args, l.state, l.notitle,
156                    m.name, m.fname, m.hidden, m.nocache, m.pos, m.class_name,
157                    acl_module.acl_register_id
158            FROM layout as l, modules as m LEFT JOIN acl_module ON (acl_module.modules_id = m.id)
159            WHERE l.user_id=?
160            AND l.kategorija_id=?
161            AND m.id=l.module_id
162            ORDER BY pozicija,redoslijed DESC
163            });
164            $sth->execute( 1, $category->{id} );
165    
166            while (my $row = $sth->fetchrow_hashref() ) {
167                    warn dump( $row ) if $debug;
168                    push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => module_args( $row ) };
169            }
170    
171            warn "### post layout...\n" if $debug;
172    
173            $sth = $dbh->prepare(qq{
174            SELECT layout_id, module_id, pozicija, module_args, name, notitle
175            FROM pre_layout, modules
176            WHERE id=module_id AND ? = template_id AND redoslijed < 0
177            ORDER BY redoslijed DESC
178            });
179            $sth->execute( $category->{template_id} );
180    
181            while (my $row = $sth->fetchrow_hashref() ) {
182                    warn dump( $row ) if $debug;
183                    push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => module_args( $row ) };
184            }
185    
186            return $page;
187    
188    }
189    
190    =head2 sites
191    
192            my @sites = $strix->sites;
193    
194    =cut
195    
196    sub sites {
197            my $self = shift;
198    
199            my @sites;
200    
201            my $sth = $self->dbh->prepare(
202            "SELECT *, coalesce(( length(ordstr)/3 ) - 1,0) AS depth FROM site ORDER BY ordstr"
203            );
204            $sth->execute;
205    
206            while (my $row = $sth->fetchrow_hashref() ) {
207                    push @sites, $row;
208            }
209    
210            return @sites;
211    }
212    
213    =head2 site_navigation
214    
215      my $navigation = $strix->site_navigation( $site_id, $uid );
216    
217    =cut
218    
219    sub site_navigation {
220            my $self = shift;
221    
222            my ( $site_id, $uid ) = @_;
223    
224            $uid ||= 1; # anonymous
225    #       $uid ||= 2; # admin
226    
227            my $cache_format = 'site-%d-navigation-for-uid-%d.js';
228            if ( my $data = $self->read_cache( $cache_format, $site_id, $uid ) ) {
229                    return $data;
230            }
231    
232    
233            my $sth = $self->dbh->prepare(
234            "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");
235            $sth->execute( $site_id, $uid );
236    
237            Jifty->log->debug("site $site_id has ", $sth->rows, " categories for uid $uid");
238    
239            my $navigation = [];
240    
241            my @pos = ( 0 );
242    
243            while (my $kat = $sth->fetchrow_hashref() ) {
244                    warn "# kat = ",dump( $kat ) if $debug;
245                    if ( ! $kat->{depth} ) {
246                            Jifty->log->error("depth increased to 1 in ",dump( $kat ));
247                            $kat->{depth} = 1;
248                    }
249    
250                    my $node = { type => 'category' };
251                    foreach my $c ( qw/naziv url/ ) {
252                            $node->{$c} = $kat->{$c};
253                    }
254    
255                    my $depth = $kat->{depth};
256                    if ( ! defined $pos[ $depth - 2 ] ) {
257                            warn "FIXING CATEGORY: ",dump( $kat );
258                            $node->{class} = "error";
259                            $depth--;
260                    }
261                    @pos = splice( @pos, 0, $depth );
262                    $pos[ $depth - 1 ]++;
263    
264                    warn "## category depth = $depth pos = ",dump( @pos ) if $debug;
265    
266                    my $code = '$navigation';
267                    map { $code .= '->[' . ( $_ - 1 ) . ']->{children}' } @pos;
268                    $code =~ s/->{children}$//;
269                    warn "## category code: $code\n" if $debug;
270                    eval $code . '= $node';
271                    if ( $@ ) {
272                            warn "SKIPPED CATEGORY: $@ ",dump( $kat );
273                            next;
274                    }
275    
276                    my $sth_ms = $self->dbh->prepare(
277                    "SELECT
278                            multistatic.id, multistatic.title, multistatic.kname,
279                            multistatic_navigation.kategorija_id, multistatic_navigation.prikaz,
280                            (LENGTH(multistatic_navigation.prikaz)/3) AS depth
281                    FROM multistatic, multistatic_navigation
282                    WHERE multistatic.id = multistatic_navigation.multistatic_id
283                            AND multistatic_navigation.prikaz != ''
284                            AND multistatic_navigation.kategorija_id = ?
285                            AND multistatic.title != ''
286                    ORDER BY multistatic_navigation.prikaz");
287                    $sth_ms->execute( $kat->{id} );
288    
289                    if ( my $rows = $sth_ms->rows ) {
290                            Jifty->log->debug("$site_id has $rows multistatic pages");
291    
292                            while (my $ms = $sth_ms->fetchrow_hashref() ) {
293                                    warn "# ms = ",dump( $ms ) if $debug;
294    
295                                    my $node = {
296                                            naziv => $ms->{title},
297                                            url => $kat->{url} . '?ms_nav=' . $ms->{prikaz},
298                                            type => 'multistatic',
299                                    };
300                                    
301                                    my $ms_depth = $ms->{depth} + $depth;
302                                    my $p = $pos[ $ms_depth - 1 ]++;
303                                    warn "## multistatic depth = $ms_depth pos = ",dump( @pos ) if $debug;
304    
305                                    my $ms_code = $code . '->{children}->[ ' . $p . ']  = $node';
306                                    warn "## multistatic code: $ms_code\n" if $debug;
307                                    eval $ms_code;
308                                    if ( $@ ) {
309                                            warn "SKIPPED MULTISTATIC: $@ ",dump( $ms );
310                                            next;
311                                    }
312                            }
313                    }
314    
315            }
316    
317            $self->write_cache( $navigation, $cache_format, $site_id, $uid );
318    
319            return $navigation;
320    
321    }
322    
323    =head2 cache_path
324    
325      my $path = $strix->cache_path( 'format-%d', $var, ... );
326    
327    =cut
328    
329    sub cache_path {
330            my $self = shift;
331    
332            warn "# cache_path",dump( @_ );
333    
334            my $path = Jifty::Util->absolute_path( 'var/strix' );
335    
336            if ( ! -e $path ) {
337                    mkdir $path || die "can't create $path: $!";
338            }
339    
340            $path .= '/' . sprintf( shift, @_ );    # XXX shift is important here!
341            return $path;
342    }
343    
344    =head2 write_cache
345    
346      write_cache( $data, 'format-%d', $var, ... );
347    
348    =cut
349    
350    sub write_cache {
351            my $self = shift;
352            my $data = shift || confess "no data?";
353            my $path = $self->cache_path( @_ );
354            write_file( $path, encode_json( $data )) || die "can't save into $path: $!";
355    }
356    
357    =head2 read_cache
358    
359            my $data = read_cache( 'format-%d', $var ... );
360    
361    =cut
362    
363    sub read_cache {
364            my $self = shift;
365            my $path = $self->cache_path( @_ );
366            return unless -e $path;
367            warn "# read_cache( $path )";
368            return decode_json( read_file( $path ) ) || die "can't read $path: $!";
369    }
370    
371  1;  1;
Legend:
Removed from v.167  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.26