Contenido Project
version 7
SVN-репозиторий
Line # Revision Author
1 3 ahitrov@rambler.ru package SQL::ProtoTable;
2
3 use strict;
4 use SQL::Common;
5 use Contenido::Globals;
6 #���������� ��������������� �������
7 #� �������� ������������
8 use base qw(SQL::CommonFilters SQL::AutoTable);
9
10 sub new {
11 my $class=shift;
12 my $self={};
13 bless ($self,$class);
14 return $self;
15 }
16
17 #most tables have extra table
18 sub have_extra {
19 return 1;
20 }
21
22 #most tables dont use single class mode
23 sub _single_class {
24 return undef;
25 }
26
27 #most tables have _auto disabled
28 sub _auto {
29 return 0;
30 }
31
32 sub available_filters {
33 return ();
34 }
35
36 #todo ����������� hardcoded 'id' �� ������ id_field ��� ��� ��� ��������������
37 sub id_field {
38 return 'id';
39 }
40
41 sub extra_table {
42 my $self=shift;
43 return $self->db_table().'_extra';
44 }
45
46 sub _get_object_key {
47 my ($self,$item,$id) = @_;
48 return ref($item) ? ref($item).'|'.$item->id : $item.'|'.$id;
49 }
50
51 # ������� � ����������� ����������, ���������� ������������ ������.
52 # ������ name, �� undef ������������ ��� �������� �������� �� memcached -
53 # � ���� ������ ��������� � ����������� ����� �������� �� ����� ��������
54 # ��������� �����������.
55 sub unique_attr {
56 return undef;
57 }
58
59 sub _get_object_unique_key {
60 my ($self, $item, $value) = @_;
61 my $attr = $self->unique_attr;
62 return undef unless defined $attr;
63 return
64 ref($item)
65 ? ref($item) . '|' . $attr . '|' . $item->$attr
66 : $item . '|' . $attr . '|' . $value;
67 }
68
69 sub required_hash {
70 my $self = shift;
71 my $class = ref $self || $self;
72 return unless scalar $self->required_properties();
73 {
74 no strict 'refs';
75 if ( ref( ${ $class.'_required_hash' } ) eq 'HASH' ) {
76 return ${ $class.'::_required_hash' };
77 } else {
78 my $struct;
79 foreach my $field ( $self->required_properties() ) {
80 $struct->{$field->{attr}} = $field;
81 }
82 ${ $class.'::_required_hash' } = $struct;
83 return $struct;
84 }
85 use strict;
86 }
87 }
88
89 sub _get_fields {
90 my $self =shift;
91 my @fields;
92 foreach ($self->required_properties()) {
93 next if ($_->{attr} eq 'class' or $_->{attr} eq 'id');
94 next unless ($_->{db_field});
95 push @fields, ($_->{no_prefix_db_field} ? '' : 'd.') . $_->{db_field};
96 }
97 return @fields;
98 }
99
100
101 sub _get_orders {
102 my $self =shift;
103 my %opts=@_;
104
105 my $rh = $self->required_hash();
106
107 if (exists($opts{order})) {
108 if (ref($opts{order}) eq 'ARRAY' and scalar(@{$opts{order}})==2) {
109 my $order = ($opts{order}->[1] eq 'reverse') ? 'ASC' : 'DESC';
110 if (lc($opts{order}->[0]) eq 'id') {
111 return " ORDER BY d.id $order";
112 } elsif (lc($opts{order}->[0]) eq 'date') {
113 my $field = $opts{usedtime};
114 $field =~ s/^d\.(.*)$/$1/;
115 if ($rh->{$field}) {
116 return " ORDER BY $opts{usedtime} $order";
117 } else {
118 warn "Contenido Warning: attempt sort by $opts{usedtime} but no $field field in db...";
119 return undef;
120 }
121 } elsif(lc($opts{order}->[0]) eq 'name') {
122 if ($rh->{name}) {
123 return " ORDER BY d.name $order";
124 } else {
125 warn "Contenido Warning: attempt sort by 'name' but no 'name' field in db...";
126 return undef;
127 }
128 } else {
129 warn "Contenido Warning: �� ������ ������ ���������� �������� ������ �� ���� id ��� ���� ��� �����.";
130 }
131 } else {
132 my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
133 my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
134 warn "WARNING: $$ ".__PACKAGE__." ".scalar(localtime()).($mason_file ? " called from $mason_file " : ' ').'�������� ������ ������� ����������. ��� ������ ���� ������ �� ������ � ����� ������ - ��������� ������� � ������������ ����������, �� ����� �����: '.Data::Dumper::Dumper($opts{order})."\n";
135 }
136 #custom hand made order
137 } elsif ($opts{order_by}) {
138 return " ORDER BY $opts{order_by}";
139 }
140 return "";
141 }
142
143 #�������� 2 ���� ��������... ������ ������ ������� ����� � self->available_filters � �������������� ������� ����������� �� ������ ��������� ������� � ����
144 sub apply_filters {
145 my ($self, $opts) = @_;
146
147 unless (exists $opts->{usedtime}) {
148 $opts->{usedtime} = 'd.dtime';
149 $opts->{usedtime} = 'd.mtime' if (exists($opts->{use_mtime}) && $opts->{use_mtime}==1);
150 $opts->{usedtime} = 'd.ctime' if (exists($opts->{use_ctime}) && $opts->{use_ctime}==1);
151 }
152
153 #��������� ������������� ������ �������� � ��������
154 #ToDo ������� �������� ��� ������� ������ SQL::FilterSet
155 my $filter_set = {wheres=>[], binds=>[], joins=>[], join_binds=>[]};
156
157 no strict 'refs';
158
159 #main loop on allowed filters
160 my $available_filters = $self->available_filters();
161 foreach my $filter (@$available_filters) {
162 $self->_add_filter_results($filter_set, $self->$filter(%$opts));
163 }
164 #loop on autofilters
165 my $filters = ${(ref($self)||$self).'::filters'} || {};
166 foreach my $key (keys %$opts) {
167 $self->_add_filter_results($filter_set, &{$filters->{$key}}($opts->{$key}, $opts)) if ($filters->{$key});
168 }
169 #apply sort_join (� ����� ����� ����� ��� joins ����������)
170 $self->_add_filter_results($filter_set, $self->_sort_join($opts));
171
172 return $filter_set;
173 }
174
175 #������ �������� � $filter_set
176 sub _add_filter_results {
177 my ($self, $filter_set, $where, $bind, $join, $join_bind) = @_;
178 push @{$filter_set->{wheres}}, $where && ref($where) eq 'ARRAY' ? @$where : $where || ();
179 push @{$filter_set->{binds}}, $bind && ref($bind) eq 'ARRAY' ? @$bind : $bind || ();
180 push @{$filter_set->{joins}}, $join && ref($join) eq 'ARRAY' ? @$join : $join || ();
181 push @{$filter_set->{join_binds}}, $join_bind && ref($join_bind) eq 'ARRAY' ? @$join_bind : $join_bind || ();
182 }
183
184 sub _sort_join {
185 my ($self, $opts) = @_;
186 return undef unless ($opts->{sort_list} and $opts->{no_order} and (ref($opts->{sort_list}) eq 'ARRAY') and @{$opts->{sort_list}});
187 #����������� ���� ��� ������ �� ��� ���� ����� ����� �� order_tabl.pos �����������
188 $opts->{_sort_join_used} = 1;
189 my $value = $opts->{sort_list};
190 my $ph_string = '?, 'x$#{$value}.'?';
191 return (undef,undef,[" left outer join (select (ARRAY[$ph_string]::integer[])[pos] as id,pos from generate_series(1,?) as pos) as order_table on d.id=order_table.id "], [@$value, $#{$value}+1]);
192 }
193
194 sub get_fields {
195 my ($self, $opts, $joins) = @_;
196
197 my $fields;
198 if ($opts->{names}) {
199 #possible incompatible with custom tables if not exist 'name' field
200 $fields = ['d.id','d.name'];
201 } elsif ($opts->{ids}) {
202 $fields = ['d.id'];
203 } elsif ($opts->{field}) {
204 if (ref($opts->{field}) eq 'ARRAY') {
205 $fields = [ map {/\./ ? $_:'d.'.$_} @{$opts->{field}} ];
206 } else {
207 $fields = [ $opts->{field} =~ /\./ ? $opts->{field}:'d.'.$opts->{field} ];
208 }
209 } elsif ($opts->{count}) {
210 $fields = [$opts->{distinct} ? 'COUNT (DISTINCT d.id)':'COUNT(d.id)'];
211 } else {
212 if ($self->_single_class) {
213 $fields = ["'".$self->_single_class."'", 'd.id', $self->_get_fields()];
214 } else {
215 $fields = ['d.class', 'd.id', $self->_get_fields()];
216 }
217
218 if (!$opts->{light} and $self->have_extra()) {
219 if ($Contenido::Globals::store_method eq 'sqldump') {
220 push @$fields, 'extra.data';
221 push @$joins, ' LEFT JOIN '.$self->db_table.'_extra AS extra ON extra.id=d.id ';
222 } elsif ($Contenido::Globals::store_method eq 'toast') {
223 push @$fields, 'd.data';
224 }
225 }
226 }
227 return $fields;
228 }
229
230 #��� ������ ��� ������� �� �������� 2 �������� ����
231 sub generate_sql {
232 my ($self,%opts)=@_;
233
234 #�������� ������ �������� � �������� � ���
235 my $filter_set = $self->apply_filters(\%opts);
236
237 #�������� ����������� $joins ���
238 my $fields = $self->get_fields(\%opts, $filter_set->{joins});
239
240 my $query = 'SELECT ';
241 $query .= ' DISTINCT ' if ($opts{distinct} and !$opts{count});
242 $query .= ' '.join(', ', @$fields).' FROM '.$self->db_table.' AS d';
243 $query .= ' '.join(' ', @{$filter_set->{joins}}) if (@{$filter_set->{joins}});
244 $query .= ' WHERE '.join(' AND ', @{$filter_set->{wheres}}) if (@{$filter_set->{wheres}});
245 $query .= ' '.$self->_get_orders(%opts) unless ($opts{no_order});
246 $query .= ' ORDER BY order_table.pos ' if ($opts{_sort_join_used});
247 $query .= ' '.&SQL::Common::_get_limit (%opts);
248 $query .= ' '.&SQL::Common::_get_offset(%opts);
249
250 return \$query, [@{$filter_set->{join_binds}}, @{$filter_set->{binds}}];
251 }
252
253 sub required_properties {
254 my $self = shift;
255 my $class = ref($self) || $self;
256
257 #���� �� ���� �� ���� �� ������ ��������
258 die "$class have no _auto enabled and no required_properties!!!" unless ($class->_auto());
259
260 my $set;
261 {
262 no strict 'refs';
263 SQL::ProtoTable->table_init($class) unless (${$class.'::_init_ok'});
264 $set = ${$class.'::_rp'};
265 }
266 die "$class have wrong internal structure" unless ($set and (ref($set) eq 'ARRAY'));
267 return @$set;
268 }
269
270 sub table_init {
271 my $self = shift;
272 my $class = shift;
273
274 unless ($class) {
275 my ($package, $filename, $line) = caller;
276 die "table_init called for empty class from '$package' '$filename' '$line'\n";
277 }
278
279 unless ($INC{$class}) {
280 eval "use $class";
281 die "error on require $class: '$@'" if ($@);
282 die "class $class can't db_table" unless ($class->can('db_table') and $class->db_table);
283 die "class have no required parent" unless ($class->isa('SQL::ProtoTable'));
284 }
285
286 {
287 no strict 'refs';
288 return 1 unless ($class->_auto());
289 return 1 if (${$class.'::_init_ok'});
290 }
291
292 #���� �������� ���� ����������������� ������� ������������
293 return $self->auto_init($class);
294 }
295
296 1;
297

Небольшая справка по веткам

cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.

koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.

utf8 – актуальная ветка, заточенная под UTF-8.

Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.
© 2003 – 2009 «Рамблер»
© 2010 – 2024 «Андрей (Handy) Хитров»