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

  ViewVC Help
Powered by ViewVC 1.1.26