/[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

Annotation of /lib/Strix.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 219 - (hide annotations)
Sun Jun 22 14:41:23 2008 UTC (11 years ago) by dpavlin
File size: 8333 byte(s)
exctract cache handling code to A3C::Cache
1 dpavlin 167 package Strix;
2    
3     use strict;
4     use warnings;
5    
6 dpavlin 219 use base qw(Jifty::Object Class::Accessor::Fast A3C::Cache);
7 dpavlin 174 __PACKAGE__->mk_accessors( qw(instance uid) );
8 dpavlin 167
9     use DBI;
10     use Data::Dump qw/dump/;
11 dpavlin 168 use Carp qw/confess/;
12 dpavlin 181 use Jifty;
13 dpavlin 167
14 dpavlin 213 use Carp qw/confess/;
15 dpavlin 216 use URI::Escape;
16 dpavlin 213
17 dpavlin 168 our $debug = 0;
18    
19 dpavlin 167 =head1 NAME
20    
21     Strix
22    
23     =head1 METHODS
24    
25 dpavlin 168 =head2 new
26    
27 dpavlin 174 my $strix = Strix->new({ instance => 'os-test0604-zg' });
28 dpavlin 168
29 dpavlin 167 =head2 dbh
30    
31 dpavlin 174 my $dbh = Strix->dbh( $strix_instance );
32 dpavlin 167
33 dpavlin 168 my $dbh = $strix->dbh;
34    
35 dpavlin 167 =cut
36    
37 dpavlin 174 our $instance_dbh;
38 dpavlin 193 our @instances_active;
39 dpavlin 171
40 dpavlin 167 sub dbh {
41     my $self = shift;
42    
43 dpavlin 177 my $instance = shift || ref($self) && $self->instance || confess "no instance";
44 dpavlin 167
45 dpavlin 174 return $instance_dbh->{$instance} if $instance_dbh->{$instance};
46 dpavlin 171
47 dpavlin 167 my $config = Jifty->config->app('strix') or die "need strix config";
48     my $database = $config->{database} or die "no strix.database in config";
49    
50     Jifty->log->debug("using config ", dump( $database ));
51    
52     my $dsn =
53 dpavlin 174 'DBI:Pg:dbname=' . $instance .
54 dpavlin 167 ';host=' . $database->{host} .
55     ';port=' . $database->{port};
56    
57 dpavlin 174 Jifty->log->info("Connect to instance $instance with dsn $dsn");
58 dpavlin 167
59 dpavlin 185 my $dbh = DBI->connect( $dsn, $database->{user}, $database->{passwd} ) or die "$DBI::errstr\n";
60 dpavlin 167
61 dpavlin 188 # 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 dpavlin 174 $instance_dbh->{$instance} = $dbh;
66 dpavlin 193 push @instances_active, $instance;
67 dpavlin 171
68 dpavlin 193 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 dpavlin 174 warn "## instance_dbh = ",dump( $instance_dbh ) if $debug;
75 dpavlin 171
76 dpavlin 167 return $dbh;
77     }
78    
79 dpavlin 168 =head2 category
80    
81     my $category = Strix->category( $url );
82    
83     =cut
84    
85     sub category {
86     my $self = shift;
87    
88     my $url = shift || confess "no url";
89    
90 dpavlin 216 my $data = $self->read_cache( uri_escape($url) );
91     return $data if $data;
92    
93 dpavlin 168 # sysinc/profiles.php
94     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
96     });
97     $sth->execute($url);
98    
99 dpavlin 216 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 dpavlin 168 return $category;
102     }
103    
104     =head2 layout
105    
106     my $layout = $strix->layout( $url );
107    
108     =cut
109    
110     sub layout {
111     my $self = shift;
112    
113     my $url = shift || confess "no url";
114    
115 dpavlin 216 my $data = $self->read_cache( uri_escape($url) );
116     return $data if $data;
117    
118 dpavlin 168 my $dbh = $self->dbh;
119     my $category = $self->category( $url );
120    
121     my $sth = $dbh->prepare(qq{
122     SELECT template.tfilename, template.tflags FROM template WHERE id = ?
123     });
124     $sth->execute( $category->{template_id} );
125    
126     my $template = $sth->fetchrow_hashref() or die "can't fetch template";
127    
128     warn "template = ",dump( $template ) if $debug;
129    
130     my $page;
131     warn "### free layout...\n" if $debug;
132    
133     # index.php
134     $sth = $dbh->prepare(qq{
135     SELECT layout_id, module_id, pozicija, module_args, name, fname, notitle, class_name
136     FROM pre_layout, modules
137     WHERE id=module_id AND ? = template_id AND redoslijed >= 0
138     ORDER BY redoslijed DESC
139     });
140     $sth->execute( $category->{template_id} );
141    
142 dpavlin 173 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 dpavlin 168 while (my $row = $sth->fetchrow_hashref() ) {
153     warn dump( $row ) if $debug;
154 dpavlin 173 push @{ $page->{free} }, { $row->{name} => module_args( $row ) };
155 dpavlin 168 }
156    
157     warn "### pre layout...\n" if $debug;
158    
159     $sth = $dbh->prepare(qq{
160     SELECT
161     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,
162     m.name, m.fname, m.hidden, m.nocache, m.pos, m.class_name,
163     acl_module.acl_register_id
164     FROM layout as l, modules as m LEFT JOIN acl_module ON (acl_module.modules_id = m.id)
165     WHERE l.user_id=?
166     AND l.kategorija_id=?
167     AND m.id=l.module_id
168     ORDER BY pozicija,redoslijed DESC
169     });
170     $sth->execute( 1, $category->{id} );
171    
172     while (my $row = $sth->fetchrow_hashref() ) {
173     warn dump( $row ) if $debug;
174 dpavlin 173 push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => module_args( $row ) };
175 dpavlin 168 }
176    
177     warn "### post layout...\n" if $debug;
178    
179     $sth = $dbh->prepare(qq{
180     SELECT layout_id, module_id, pozicija, module_args, name, notitle
181     FROM pre_layout, modules
182     WHERE id=module_id AND ? = template_id AND redoslijed < 0
183     ORDER BY redoslijed DESC
184     });
185     $sth->execute( $category->{template_id} );
186    
187     while (my $row = $sth->fetchrow_hashref() ) {
188     warn dump( $row ) if $debug;
189 dpavlin 173 push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => module_args( $row ) };
190 dpavlin 168 }
191    
192 dpavlin 216 $self->write_cache( $page, uri_escape($url) );
193    
194 dpavlin 168 return $page;
195    
196     }
197    
198 dpavlin 193 =head2 sites
199 dpavlin 169
200 dpavlin 193 my @sites = $strix->sites;
201 dpavlin 169
202     =cut
203    
204 dpavlin 193 sub sites {
205 dpavlin 169 my $self = shift;
206    
207 dpavlin 216 my @sites = $self->read_cache;
208     return @sites if @sites;
209 dpavlin 169
210 dpavlin 193 my $sth = $self->dbh->prepare(
211     "SELECT *, coalesce(( length(ordstr)/3 ) - 1,0) AS depth FROM site ORDER BY ordstr"
212     );
213     $sth->execute;
214 dpavlin 169
215     while (my $row = $sth->fetchrow_hashref() ) {
216 dpavlin 193 push @sites, $row;
217 dpavlin 169 }
218    
219 dpavlin 216 $self->write_cache( \@sites );
220    
221 dpavlin 193 return @sites;
222 dpavlin 169 }
223    
224     =head2 site_navigation
225    
226     my $navigation = $strix->site_navigation( $site_id, $uid );
227    
228     =cut
229    
230     sub site_navigation {
231     my $self = shift;
232    
233     my ( $site_id, $uid ) = @_;
234    
235     $uid ||= 1; # anonymous
236     # $uid ||= 2; # admin
237    
238 dpavlin 216 my $data = $self->read_cache( $site_id, $uid );
239     return $data if $data;
240 dpavlin 213
241 dpavlin 169 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");
243     $sth->execute( $site_id, $uid );
244    
245     Jifty->log->debug("site $site_id has ", $sth->rows, " categories for uid $uid");
246    
247     my $navigation = [];
248    
249     my @pos = ( 0 );
250    
251     while (my $kat = $sth->fetchrow_hashref() ) {
252     warn "# kat = ",dump( $kat ) if $debug;
253 dpavlin 193 if ( ! $kat->{depth} ) {
254     Jifty->log->error("depth increased to 1 in ",dump( $kat ));
255     $kat->{depth} = 1;
256     }
257 dpavlin 169
258     my $node = { type => 'category' };
259     foreach my $c ( qw/naziv url/ ) {
260     $node->{$c} = $kat->{$c};
261     }
262    
263     my $depth = $kat->{depth};
264 dpavlin 182 if ( ! defined $pos[ $depth - 2 ] ) {
265     warn "FIXING CATEGORY: ",dump( $kat );
266     $node->{class} = "error";
267     $depth--;
268     }
269 dpavlin 169 @pos = splice( @pos, 0, $depth );
270     $pos[ $depth - 1 ]++;
271    
272 dpavlin 173 warn "## category depth = $depth pos = ",dump( @pos ) if $debug;
273 dpavlin 169
274     my $code = '$navigation';
275     map { $code .= '->[' . ( $_ - 1 ) . ']->{children}' } @pos;
276     $code =~ s/->{children}$//;
277 dpavlin 173 warn "## category code: $code\n" if $debug;
278 dpavlin 169 eval $code . '= $node';
279     if ( $@ ) {
280     warn "SKIPPED CATEGORY: $@ ",dump( $kat );
281     next;
282     }
283    
284     my $sth_ms = $self->dbh->prepare(
285     "SELECT
286     multistatic.id, multistatic.title, multistatic.kname,
287     multistatic_navigation.kategorija_id, multistatic_navigation.prikaz,
288     (LENGTH(multistatic_navigation.prikaz)/3) AS depth
289     FROM multistatic, multistatic_navigation
290     WHERE multistatic.id = multistatic_navigation.multistatic_id
291     AND multistatic_navigation.prikaz != ''
292     AND multistatic_navigation.kategorija_id = ?
293     AND multistatic.title != ''
294     ORDER BY multistatic_navigation.prikaz");
295     $sth_ms->execute( $kat->{id} );
296    
297     if ( my $rows = $sth_ms->rows ) {
298     Jifty->log->debug("$site_id has $rows multistatic pages");
299    
300     while (my $ms = $sth_ms->fetchrow_hashref() ) {
301     warn "# ms = ",dump( $ms ) if $debug;
302    
303     my $node = {
304     naziv => $ms->{title},
305     url => $kat->{url} . '?ms_nav=' . $ms->{prikaz},
306     type => 'multistatic',
307     };
308    
309     my $ms_depth = $ms->{depth} + $depth;
310     my $p = $pos[ $ms_depth - 1 ]++;
311 dpavlin 173 warn "## multistatic depth = $ms_depth pos = ",dump( @pos ) if $debug;
312 dpavlin 169
313     my $ms_code = $code . '->{children}->[ ' . $p . '] = $node';
314 dpavlin 173 warn "## multistatic code: $ms_code\n" if $debug;
315 dpavlin 169 eval $ms_code;
316     if ( $@ ) {
317     warn "SKIPPED MULTISTATIC: $@ ",dump( $ms );
318     next;
319     }
320     }
321     }
322    
323     }
324    
325 dpavlin 216 $self->write_cache( $navigation, $site_id, $uid );
326 dpavlin 213
327 dpavlin 169 return $navigation;
328    
329     }
330    
331 dpavlin 167 1;

  ViewVC Help
Powered by ViewVC 1.1.26