/[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 216 - (show annotations)
Fri Jun 20 21:49:16 2008 UTC (15 years, 9 months ago) by dpavlin
File size: 9482 byte(s)
put cache all over the place and simplify it
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 use URI::Escape;
18
19 our $debug = 0;
20
21 =head1 NAME
22
23 Strix
24
25 =head1 METHODS
26
27 =head2 new
28
29 my $strix = Strix->new({ instance => 'os-test0604-zg' });
30
31 =head2 dbh
32
33 my $dbh = Strix->dbh( $strix_instance );
34
35 my $dbh = $strix->dbh;
36
37 =cut
38
39 our $instance_dbh;
40 our @instances_active;
41
42 sub dbh {
43 my $self = shift;
44
45 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";
50 my $database = $config->{database} or die "no strix.database in config";
51
52 Jifty->log->debug("using config ", dump( $database ));
53
54 my $dsn =
55 'DBI:Pg:dbname=' . $instance .
56 ';host=' . $database->{host} .
57 ';port=' . $database->{port};
58
59 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 # 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;
79 }
80
81 =head2 category
82
83 my $category = Strix->category( $url );
84
85 =cut
86
87 sub category {
88 my $self = shift;
89
90 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
96 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
98 });
99 $sth->execute($url);
100
101 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;
104 }
105
106 =head2 layout
107
108 my $layout = $strix->layout( $url );
109
110 =cut
111
112 sub layout {
113 my $self = shift;
114
115 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;
121 my $category = $self->category( $url );
122
123 my $sth = $dbh->prepare(qq{
124 SELECT template.tfilename, template.tflags FROM template WHERE id = ?
125 });
126 $sth->execute( $category->{template_id} );
127
128 my $template = $sth->fetchrow_hashref() or die "can't fetch template";
129
130 warn "template = ",dump( $template ) if $debug;
131
132 my $page;
133 warn "### free layout...\n" if $debug;
134
135 # index.php
136 $sth = $dbh->prepare(qq{
137 SELECT layout_id, module_id, pozicija, module_args, name, fname, notitle, class_name
138 FROM pre_layout, modules
139 WHERE id=module_id AND ? = template_id AND redoslijed >= 0
140 ORDER BY redoslijed DESC
141 });
142 $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() ) {
155 warn dump( $row ) if $debug;
156 push @{ $page->{free} }, { $row->{name} => module_args( $row ) };
157 }
158
159 warn "### pre layout...\n" if $debug;
160
161 $sth = $dbh->prepare(qq{
162 SELECT
163 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,
164 m.name, m.fname, m.hidden, m.nocache, m.pos, m.class_name,
165 acl_module.acl_register_id
166 FROM layout as l, modules as m LEFT JOIN acl_module ON (acl_module.modules_id = m.id)
167 WHERE l.user_id=?
168 AND l.kategorija_id=?
169 AND m.id=l.module_id
170 ORDER BY pozicija,redoslijed DESC
171 });
172 $sth->execute( 1, $category->{id} );
173
174 while (my $row = $sth->fetchrow_hashref() ) {
175 warn dump( $row ) if $debug;
176 push @{ $page->{pre}->{ $row->{pos} } }, { $row->{name} => module_args( $row ) };
177 }
178
179 warn "### post layout...\n" if $debug;
180
181 $sth = $dbh->prepare(qq{
182 SELECT layout_id, module_id, pozicija, module_args, name, notitle
183 FROM pre_layout, modules
184 WHERE id=module_id AND ? = template_id AND redoslijed < 0
185 ORDER BY redoslijed DESC
186 });
187 $sth->execute( $category->{template_id} );
188
189 while (my $row = $sth->fetchrow_hashref() ) {
190 warn dump( $row ) if $debug;
191 push @{ $page->{post}->{ $row->{pozicija} } }, { $row->{name} => module_args( $row ) };
192 }
193
194 $self->write_cache( $page, uri_escape($url) );
195
196 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;

  ViewVC Help
Powered by ViewVC 1.1.26