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

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

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

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

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

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