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

Contents of /lib/Strix.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 213 - (show annotations)
Fri Jun 20 20:44:18 2008 UTC (15 years, 10 months ago) by dpavlin
File size: 8980 byte(s)
add cache to Strix for performance reasons
1 package Strix;
2
3 use strict;
4 use warnings;
5
6 use base qw(Jifty::Object Class::Accessor::Fast);
7 __PACKAGE__->mk_accessors( qw(instance uid) );
8
9 use DBI;
10 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
21
22 Strix
23
24 =head1 METHODS
25
26 =head2 new
27
28 my $strix = Strix->new({ instance => 'os-test0604-zg' });
29
30 =head2 dbh
31
32 my $dbh = Strix->dbh( $strix_instance );
33
34 my $dbh = $strix->dbh;
35
36 =cut
37
38 our $instance_dbh;
39 our @instances_active;
40
41 sub dbh {
42 my $self = shift;
43
44 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";
49 my $database = $config->{database} or die "no strix.database in config";
50
51 Jifty->log->debug("using config ", dump( $database ));
52
53 my $dsn =
54 'DBI:Pg:dbname=' . $instance .
55 ';host=' . $database->{host} .
56 ';port=' . $database->{port};
57
58 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 warn "## instance_dbh = ",dump( $instance_dbh ) if $debug;
76
77 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;

  ViewVC Help
Powered by ViewVC 1.1.26