| 1 |
8 |
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 |
|
|
|
