Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 598 lines (468 sloc) 19.3 kb
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
1 package MYDLjE::M;
eb5605b Красимир Беров MYDLjE::Base - DEPRECATED - use Mojo::Base instead
authored
2 use Mojo::Base -base;
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
3 use MojoX::Validator;
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
4 use Params::Check;
5 $Params::Check::WARNINGS_FATAL = 1;
6 $Params::Check::CALLER_DEPTH = $Params::Check::CALLER_DEPTH + 1;
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
7 use Carp();
8 use MYDLjE::Regexp qw(%MRE);
9
10 sub dbix { return MYDLjE::Plugin::DBIx::instance() }
11 my $SQL = {};
12 my $DEBUG = $MYDLjE::DEBUG;
13
14 #conveninece for getting key/vaule arguments
15 sub get_args {
16 return ref($_[0]) ? shift() : (@_ % 2) ? shift() : {@_};
17 }
18 sub get_obj_args { return (shift, get_args(@_)); }
19
20 #tablename
21 sub TABLE {
22 Carp::confess("You must add a table in your class: sub TABLE {'tablename'}");
23 }
24
25 #table columns
26 sub COLUMNS {
27 Carp::confess("You must add fields in your class: sub COLUMNS {['id','name','etc']}");
28 }
29
30 has validator => sub { MojoX::Validator->new; };
31
32 sub FIELDS_VALIDATION {
33 Carp::confess('You must describe your field validations!'
34 . ' See MYDLjE::M::Content::FIELDS_VALIDATION for example.');
35
36 }
37
38 #specific where clause for this class
39 #which will be preppended to $where argument for the select() method
40 has WHERE => sub { {} };
41
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
42 has rows => sub { [] };
43
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
44 #METHODS
45 sub new {
46 my ($class, $fields) = get_obj_args(@_);
47 my $self = {data => {}};
48 bless $self, $class;
49 $class->make_field_attrs();
50 $self->data($fields);
51 return $self;
52 }
53
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
54 #get data from database
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
55 sub select { ##no critic (Subroutines::ProhibitBuiltinHomonyms)
56 my ($self, $where) = get_obj_args(@_);
57
58 #instantiate if needed
59 unless (ref $self) {
60 $self = $self->new();
61 }
7c1d676 Красимир Беров MYDLjE::M::Content is optimized.
authored
62 $self->WHERE(+{%$where, %{$self->WHERE}});
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
63
7c1d676 Красимир Беров MYDLjE::M::Content is optimized.
authored
64 $self->{data} = $self->dbix->select($self->TABLE, $self->COLUMNS, $self->WHERE)->hash;
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
65 return $self;
66 }
67
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
68 sub select_all {
69 my ($self, $where) = get_obj_args(@_);
70
71 #instantiate if needed
72 unless (ref $self) {
73 $self = $self->new();
74 }
7c1d676 Красимир Беров MYDLjE::M::Content is optimized.
authored
75 $self->WHERE(+{%$where, %{$self->WHERE}});
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
76
77 my $order = delete $where->{'order'};
78
79 $self->{rows} =
7c1d676 Красимир Беров MYDLjE::M::Content is optimized.
authored
80 [$self->dbix->select($self->TABLE, $self->COLUMNS, $self->WHERE, $order)->hashes];
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
81 return $self;
82 }
83
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
84 #fieldvalues HASHREF
85 sub data {
86 my ($self, $args) = get_obj_args(@_);
87 if (ref $args && keys %$args) {
88 for my $field (keys %$args) {
89 unless (grep { $field eq $_ } @{$self->COLUMNS()}) {
90 Carp::cluck(
91 "There is not such field $field in table " . $self->TABLE . '! Skipping...')
92 if $DEBUG;
93 next;
94 }
ea7abf0 Красимир Беров Fixes
authored
95 $self->$field($args->{$field});
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
96 }
97 }
98
99 #a key
100 elsif ($args && (!ref $args)) {
101 return $self->$args;
102 }
103
0bdeced Красимир Беров validate_field($field, $value) is DEPRECATED!
authored
104 #they want all what we touched in $self->{data}
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
105 return $self->{data};
106 }
107
108 sub save {
109 my ($self, $data) = get_obj_args(@_);
110
111 #allow data to be passed directly and overwrite current data
112 if (keys %$data) { $self->data($data); }
113 local $Carp::MaxArgLen = 0;
114 if (!defined $self->id) {
115 delete $self->{data}{id} if exists $self->{data}{id};
116 $self->dbix->insert($self->TABLE, $self->data);
117 $self->id($self->dbix->last_insert_id(undef, undef, $self->TABLE, 'id'));
118 return $self->id;
119 }
120 else {
121 return $self->dbix->update($self->TABLE, $self->data, {id => $self->id});
122 }
123 return;
124 }
125
126 sub make_field_attrs {
127 my $class = shift;
128 (!ref $class)
129 || Carp::croak('Call this method as __PACKAGE__->make_field_attrs()');
130 my $code;
131 foreach my $column (@{$class->COLUMNS()}) {
132 next if $class->can($column); #careful: no redefine
133 $code = "use strict;$/use warnings;$/use utf8;$/" unless $code;
134
135 #Carp::carp('Making sub ' . $column) if $DEBUG;
136 $code .= <<"SUB";
137 sub $class\::$column {
138 my (\$self,\$value) = \@_;
139 if(defined \$value){ #setting value
02c5fe2 Красимир Беров Migration to Params::Check seems almost done.
authored
140 \$self->{data}{$column} = \$self->check($column=>\$value);
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
141 #make it chainable
142 return \$self;
143 }
144 return \$self->{data}{$column}; #getting value
145 }
146
147 SUB
148
149 }
150 $code .= "$/1;" if $code;
151
152 #I know what I am doing. I think so... warn $code if $code;
153 if ($code && !eval $code) { ##no critic (BuiltinFunctions::ProhibitStringyEval)
154 Carp::confess($class . " compiler error: $/$code$/$@$/");
155 }
156 return;
157 }
158
e574fbf Красимир Беров some more field definitions
authored
159 sub zero_inflate {
160 return shift->value || '0';
161 }
4f02243 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE 3
authored
162
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
163 sub no_markup_inflate {
164 my $filed = shift;
165 my $value = $filed->value || '';
166
167 #remove everything strange
168 $value =~ s/$MRE{no_markup}//gx;
169
170 #normalize spaces
171 $value =~ s/\s+/ /gx;
172 $value = substr($value, 0, 254) if length($value) > 254;
173 return $value;
174 }
175
c88746a workaround to avoid markitup CSS conflicts
helmut authored
176 # TODO: Move ALL validation stuff to MYDLjE::Validator which will inherit MojoX::Validator.
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
177 sub domain_regexp {
178
c88746a workaround to avoid markitup CSS conflicts
helmut authored
179 # stolen from Regexp::Common::URI::RFC2396;
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
180 my $digit = '[0-9]';
181 my $upalpha = '[A-Z]';
182 my $lowalpha = '[a-z]';
183 my $alpha = '[a-zA-Z]'; # lowalpha | upalpha
184 my $alphanum = '[a-zA-Z0-9]'; # alpha | digit
185 my $port = "(?:$digit*)";
186 my $IPv4address = "(?:$digit+[.]$digit+[.]$digit+[.]$digit+)";
187 my $toplabel = "(?:$alpha" . "[-a-zA-Z0-9]*$alphanum|$alpha)";
188 my $domainlabel = "(?:(?:$alphanum" . "[-a-zA-Z0-9]*)?$alphanum)";
189 my $hostname = "(?:(?:$domainlabel\[.])*$toplabel\[.]?)";
190 my $host = "(?:$hostname|$IPv4address)";
191 my $hostport = "(?:$host(?::$port)?)";
192 return qr/^$host$/x;
193 }
194
195 #validates $value for $field against $self->FIELDS_VALIDATION->{$field} rules.
196 sub validate_field {
197 my ($self, $field, $value) = @_;
0bdeced Красимир Беров validate_field($field, $value) is DEPRECATED!
authored
198 Carp::carp ref($self) . "::validate_field($field, $value) is DEPRECATED!";
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
199 my $rules = \%{$self->FIELDS_VALIDATION->{$field}}; #copy?!
200
201 return $value unless $rules; #no validation rules defined
202
203 my $field_obj = $self->validator->field($field);
204 my $constraints = delete $rules->{constraints};
205 for my $method (keys %$rules) {
206 $field_obj->$method($rules->{$method});
207 }
208
209 if (ref($constraints) eq 'ARRAY'
210 && scalar @$constraints)
211 {
212 foreach (@$constraints) {
213 $field_obj->constraint(%$_);
214 }
215 }
216 $self->validator->validate({$field => $value});
217 if ($self->validator->errors && $self->validator->errors->{$field}) {
218 local $Carp::CarpLevel = 1;
219 Carp::confess($self->validator->errors->{$field});
220 }
221 return $self->validator->values->{$field};
222
223 }
224
c88746a workaround to avoid markitup CSS conflicts
helmut authored
225 # Common field definitions to be used accross all subclasses
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
226 my $id_regexp = {regexp => qr/^\d+$/x};
227 my $bool_regexp = {regexp => qr/^[01]$/x};
228 my $FIELD_DEFS = {
229 id => {required => 0, %$id_regexp},
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
230 pid => {required => 1, %$id_regexp},
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
231 domain_id => {required => 1, %$id_regexp},
232 alias32 => {required => 1, regexp => qr/^[\-_a-zA-Z0-9]{2,32}$/x,},
233 alias => {required => 1, regexp => qr/^[\-_a-zA-Z0-9]{2,255}$/x,},
234 sorting => {
235 required => 1,
236 %$id_regexp,
237 inflate => sub { return ($_[0]->value || time()) },
238 },
239 permissions => {
240
c88746a workaround to avoid markitup CSS conflicts
helmut authored
241 # required => 1,
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
242 inflate => sub { return $_[0]->value ? $_[0]->value : '-rwxr-xr-x'; },
243 regexp => qr/^
244 $MRE{perms}{ldn} # is this a directory, link or a regular record ?
245 $MRE{perms}{rwx} # owner's permissions - (r)ead,(w)rite,e(x)ecute
246 $MRE{perms}{rwx} # group's permissions - (r)ead,(w)rite,e(x)ecute
247 $MRE{perms}{rwx} # other's permissions - (r)ead,(w)rite,e(x)ecute
248 $/x,
249 },
4f02243 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE 3
authored
250 user_id => {required => 1, %$id_regexp},
251 group_id => {required => 1, %$id_regexp},
252 cache => {required => 0, %$bool_regexp, inflate => \&zero_inflate},
253 deleted => {required => 0, %$bool_regexp},
254 hidden => {required => 0, %$bool_regexp, inflate => \&zero_inflate},
255 changed_by => {required => 1, %$id_regexp},
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
256 title => {required => 0, inflate => \&no_markup_inflate},
257 description => {required => 0, inflate => \&no_markup_inflate},
4f02243 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE 3
authored
258 domain => {required => 1, regexp => domain_regexp()},
259 start => {required => 0, %$id_regexp, inflate => \&zero_inflate},
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
260 };
261 $FIELD_DEFS->{name} = $FIELD_DEFS->{title};
e574fbf Красимир Беров some more field definitions
authored
262 $FIELD_DEFS->{stop} = $FIELD_DEFS->{start};
4f02243 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE 3
authored
263
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
264 sub FIELD_DEF {
265 my ($self, $key) = @_;
266 if ($FIELD_DEFS->{$key}) {
267 return ($key => $FIELD_DEFS->{$key});
268 }
269 Carp::cluck("No field definition for: [$key].");
270 return ();
271 }
272
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
273 #some commonly used fields in tables
274 # validated via Params::Check::check()
275 my $id_allow = {allow => qr/^\d+$/x};
276 my $bool_allow = {allow => qr/^[01]$/x};
277 my $FIELDS = {
278 id => {required => 0, %$id_allow},
279 pid => {required => 1, %$id_allow},
280 cache => {required => 0, %$bool_allow, default => 0},
281 alias32 => {required => 1, allow => qr/^[\-_a-zA-Z0-9]{2,32}$/x,},
282 alias => {required => 1, allow => qr/^[\-_a-zA-Z0-9]{2,255}$/x,},
283 title => {
284 required => 0,
285 allow => sub {
286 $_[0] =~ s/$MRE{no_markup}//gx;
287 $_[0] =~ s/\s+/ /gx;
288 $_[0] = substr($_[0], 0, 254) if length($_[0]) > 254;
289 return 1;
290 }
291 },
292 permissions => {
4f02243 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE 3
authored
293 allow => sub {
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
294 $_[0] ||= '-rwxr-xr-x';
295 $_[0] =~ /^
296 $MRE{perms}{ldn} # is this a directory, link or a regular record ?
297 $MRE{perms}{rwx} # owner's permissions - (r)ead,(w)rite,e(x)ecute
298 $MRE{perms}{rwx} # group's permissions - (r)ead,(w)rite,e(x)ecute
299 $MRE{perms}{rwx} # other's permissions - (r)ead,(w)rite,e(x)ecute
300 $/x
301 },
302 },
0bdeced Красимир Беров validate_field($field, $value) is DEPRECATED!
authored
303 sorting => {
304 required => 1,
305 %$id_allow,
306 allow => sub {
307 $_[0] ||= time();
308 return $_[0] =~ /$id_allow->{allow}/x ? 1 : 0;
309 },
310 },
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
311 };
312
02c5fe2 Красимир Беров Migration to Params::Check seems almost done.
authored
313 $FIELDS->{description} = $FIELDS->{title};
314 $FIELDS->{changed_by} = $FIELDS->{domain_id} = $FIELDS->{user_id} =
315 $FIELDS->{group_id} = $FIELDS->{pid};
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
316 $FIELDS->{deleted} = $FIELDS->{cache};
317
318 #Works only with current package fields!!! So sublass MUST implement it.
319 sub FIELDS {
02c5fe2 Красимир Беров Migration to Params::Check seems almost done.
authored
320 my ($class, $key) = @_;
321 $class = ref($class) || $class;
322 ($class eq __PACKAGE__)
323 or Carp::croak('You must implement ' . $class . '::FIELDS');
324 return $key ? $FIELDS->{$key} : $FIELDS;
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
325 }
326
327
0bdeced Красимир Беров validate_field($field, $value) is DEPRECATED!
authored
328 sub check {
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
329 my ($self, $key, $value) = @_;
330
c88746a workaround to avoid markitup CSS conflicts
helmut authored
331 # warn Data::Dumper::Dumper($self->FIELDS);die;
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
332 my $args_out =
333 Params::Check::check({$key => $self->FIELDS($key) || {}}, {$key => $value});
334 return $args_out->{$key};
335 }
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
336
c88746a workaround to avoid markitup CSS conflicts
helmut authored
337 # TODO:Utility function used for passing custom SQL in Model Classes.
338 # $SQL is loaded from file during initialization
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
339 sub sql {
340 my ($key) = @_;
341 if ($key && exists $SQL->{$key}) {
342 return $SQL->{$key};
343 }
344 Carp::cluck('Empty SQL QUERY!!! boom!!?');
345 return '';
346 }
9e36b52 Красимир Беров Drastic speed improvement using Params::Check -UNSTABLE
authored
347
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
348
349 1;
350
351 __END__
352
353 =encoding utf8
354
355 =head1 NAME
356
357 MYDLjE::M - an oversimplified database-based objects class.
358
359 =head1 DESCRIPTION
360
c88746a workaround to avoid markitup CSS conflicts
helmut authored
361 This is the base class for all classes that store their data in a L<MYDLjE> database table. It was written in order to decrease dependencies from CPAN modules and keep MYDLjE small and light.
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
362
363 The class provides some useful methods which simplify representing rows from tables as Perl objects. It is not intended to be a full featured ORM at all. It is rather a DBA (Database Abstraction Layer). It simply saves you from writing the same SQl over and over again to construct well known MYDLjE objects stored in tables' rows. If you have to do complicated SQL queries use directly L<DBIx::Simple/query> method. A L<DBIx::Simple> singleton instance is available as attribute in every L<MYDLjE::M> derived object. Use this base class if you want to construct Perl objects which store their data in table rows. That's it.
364
365 This code is fresh and may change at any time but I will try to keep the API relatively stable if I like it.
366 And of course you can always overwrite all methods from this base class at will and embed complex SQL queries in your subclasses.
367
368 =head1 SYNOPSIS
369
c88746a workaround to avoid markitup CSS conflicts
helmut authored
370 # in your class representing a template for a row in
371 # a table or view or whatever database object
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
372
373 package MYDLjE::M::Content::Note;
eb5605b Красимир Беров MYDLjE::Base - DEPRECATED - use Mojo::Base instead
authored
374 use Mojo::Base 'MYDLjE::M::Content';
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
375
376 has TABLE => 'content';
377 has COLUMNS => sub {
378 [ qw(
379 id user_id pid
380 data_type data_format time_created tstamp title alias
381 body invisible language groups protected bad
382 )
383 ];
384 };
385 has WHERE => sub { {data_type => 'note'} };
386
387 sub FIELDS_VALIDATION {
388 return {
389 id => {required => 0, constraints => [{regexp => qr/^\d+$/x},]},
390 user_id => {required => 1, constraints => [{regexp => qr/^\d+$/x},]},
391 alias => {
392 required => 1,
393 constraints => [{regexp => qr/^[\-_a-z0-9]{2,255}$/x},]
394 },
395 #...
396 }
397 }
398
399
c88746a workaround to avoid markitup CSS conflicts
helmut authored
400 # ... somewhere in your application or controller or a custom script
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
401 my $note = MYDLjE::M::Content::Note->select({id=>5});
c88746a workaround to avoid markitup CSS conflicts
helmut authored
402 # or
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
403 my $user = MYDLjE::M::User->select(login_name => 'guest')
404 $user->password(Mojo::Util::md5_sum('myverysecReTPasWord123'));
405
c88746a workaround to avoid markitup CSS conflicts
helmut authored
406 # do whatwever you do with this object, then save it
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
407 $user->save;
408
c88746a workaround to avoid markitup CSS conflicts
helmut authored
409 # or create something really fresh
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
410 my $question = MYDLjE::M::Content::Question->new(
411 user_id => $c->msession->user_id,
412 title => 'How to cook with MYDLjE?',
413 body => '<p>I really want to know where to start from. Should I....</p>'
414 ...
415 );
416
417
418 =head1 ATTRIBUTES
419
420 =head2 dbix
421
422 This is an L<MYDLjE::Plugin::DBIx/instance> and (as you guessed) provides direct access
423 to the current DBIx::Simple instance with L<SQL::Abstract> support.
424
425 =head2 TABLE
426
427 You must define this attribute in your subclass. This is the table where your object
428 will store its data. Must return a string - the table name. It is used internally in L<select>
429 when retreiving a row from the database and when saving object data.
430
431 has TABLE => 'users';
432 # in select()
433 $self->data(
434 $self->dbix->select($self->TABLE, $self->COLUMNS, $where)->hash);
435
436
437
438 =head2 COLUMNS
439
440 You must define this attribute in your subclass.
441 It must return an ARRAYREF with table columns to which the data is written.
442 It is used internally in L<select> when retreiving a row from the database and when saving object data.
443
444 has COLUMNS => sub { [qw(id cid user_id tstamp sessiondata)] };
445 # in select()
446 $self->data(
447 $self->dbix->select($self->TABLE, $self->COLUMNS, $where)->hash);
448
449
450 =head2 FIELDS_VALIDATION
451
452 You must define this attribute in your subclass.
c88746a workaround to avoid markitup CSS conflicts
helmut authored
453 It must return a HASHREF with column names as keys and "types" constraints as values
454 interpreted by L<validate_field> which will check and validate the value of a column
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
455 each time a new value is set.
456
457 has FIELDS_VALIDATION => sub {
458 { login_name =>
459 {required => 1, constraints => [{regexp => qr/^\p{IsAlnum}{4,100}$/x}]},
460 login_password =>
461 {required => 1, constraints => [{regexp => qr/^[a-f0-9]{32}$/x}]},
462 email => {required => 1, constraints => [{'email' => 'email'},]},
463 first_name => {constraints => [{length => [3, 100]}]},
464 last_name => {constraints => [{length => [3, 100]}]},
465 #...
466 }
467 };
468
469 =head2 validator
470
471 MojoX::Validator instance used to validate the fields as described in L</FIELDS_VALIDATION>.
472
473 =head2 WHERE
474
475 Specific C<WHERE> clause for your class which will be appended to C<where> arguments for the L</select> method. Empty by default.
476
477 has WHERE => sub { {data_type => 'note'} };
478
479 You can redefine the WHERE clause for the object data population just after instatntiating an empty object and before calling select to populate it with data.
480
481 my $user = MYDLjE::M::User->new();
c88746a workaround to avoid markitup CSS conflicts
helmut authored
482 $user->WHERE({disabled => 0, });
483 $user->select(id => 1);
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
484
485 =head1 METHODS
486
487 =head2 new
488
489 The constructor. Instantiates a fresh MYDLjE::M based object. Generates getters and setters for the fields described in L</COLUMNS>. Sets the passed parameters as fields if they exists as column names.
490
491 #Restore user object from sessiondata
492 if($self->sessiondata->{user_data}){
493 $self->user(MYDLjE::M::User->new($self->sessiondata->{user_data}));
494 }
495
496 =head2 select
497
498 Instantiates an object from a saved in the database row by constructing and executing an SQL query based on the parameters. These parameters are used to construct the C<WHERE> clause for the SQL C<SELECT> statement. The API is the same as for L<DBIx::Simple/select> or L<SQL::Abstract/select> which is used internally. Prepends the L</WHERE> clause defined by you to the parameters. If a row is found puts in L</data>. Returns C<$self>.
499
500 my $user = MYDLjE::M::User->select(id => $user_id);
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
501
502
503 =head2 select_all
504
505 Selects many records from this class L</TABLE> and this class L</COLUMNS>.
506 The paramethers C<$where> and C<$order> are the same as described in L<SQL::Abstract>.
c88746a workaround to avoid markitup CSS conflicts
helmut authored
507 Returns an array reference of hashes. If you want objects, you must instantiate them one by one.
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
508
509 my $users_as_hashes = MYDLjE::M::User->select_all($where, $order)->rows;
c88746a workaround to avoid markitup CSS conflicts
helmut authored
510 # but i need MYDLjE::M::User instances
a4b731b Красимир Беров experimental select_all() in MYDLjE::M
authored
511 my @users_as_objects = map {MYDLjE::M::User->new($_)} @$userS_as_hashes;
512
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
513 =head2 data
514
02bece0 Красимир Беров Optimized MYDLjE::M->data() to not validate fields
authored
515 Common getter/setter for all L</COLUMNS>.
516 Does not validate the field when setting a value.
517 Use the field specific setter if you want to be sure the input is validated
518 before saving in database.
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
519
520 In L</select>:
521
522 $self->data($self->dbix->select($self->TABLE, $self->COLUMNS, $where)->hash);
523
524 But also use the autogenereated or defined by you getters/setters.
525
526 my $title = $self->data->{title};
527 $self->data('title','My Title');
528 $self->title('My Title');
529 $self->title; # My Title
530
531 =head2 save
532
c88746a workaround to avoid markitup CSS conflicts
helmut authored
533 DWIM saver. If the object is fresh ( C<if (!$self-E<gt>id)> ) prepares and executes an C<INSERT> statement, otherwise preforms an C<UPDATE>. L</TABLE> is used to construct the SQL.
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
534
535 =head2 make_field_attrs
536
537 Called by L</new>. Prepares class specific COLUMNS based getters/setters.
538 You I<could> overrride it in your specific class if you want to do something special.
539
540 =head2 validate_field
541
542 Validates C<$value> for $field against C<$self-E<gt>FIELDS_VALIDATION-E<gt>{$field}> rules.
543 Called each time a field is set either by the specific field setter or by L</data>.
544
545 =head2 FIELD_DEF
546
c88746a workaround to avoid markitup CSS conflicts
helmut authored
547 Returns a field definition of a commonly used field across many tables as
72bc745 Красимир Беров Start by importing MYDLjE release 01.09.18b3
authored
548 a hash with only one key.
549
550 There are several fieldnames and types that are commonly used in database tables.
551 This method returns the definition of just one field by given field name.
552 This is particulary useful when you define a class to represent a row in a table and you
553 have to define in L</FIELDS_VALIDATION> a column which is identical to another column already defined in another class.
554
555 Currently predefined fields are:
556
557 id => {required => 0, %$id_regexp},
558 pid => {required => 1, %$id_regexp},
559 alias32 => {required => 1, regexp => qr/^[\-_a-zA-Z0-9]{3,32}$/x,},
560 alias => {required => 1, regexp => qr/^[\-_a-zA-Z0-9]{3,255}$/x,},
561 sorting => {
562 required => 1,
563 regexp => qr/^\d+$/x,
564 inflate => sub { return ($_[0]->value || time()) },
565 },
566 permissions => {
567 required => 0,
568 regexp => qr/^
569 [d\-] # is this a directory - does it actually contain any children ?
570 [r\-][w\-][x\-] # owner's permissions - (r)ead,(w)rite,e(x)ecute
571 [r\-][w\-][x\-] # group's permissions - (r)ead,(w)rite,e(x)ecute
572 [r\-][w\-][x\-] # other's permissions - (r)ead,(w)rite,e(x)ecute
573 $/x,
574 },
575 user_id => {required => 1, %$id_regexp},
576 group_id => {required => 1, %$id_regexp},
577 cache => {required => 0, %$bool_regexp},
578 deleted => {required => 0, %$bool_regexp},
579 hidden => {required => 0, %$bool_regexp},
580 changed_by => {required => 1, %$id_regexp},
581
582
583 See the source of MYDLjE::M::Content and MYDLjE::M::Page for examples.
584
585
586 =head1 SEE ALSO
587
588 L<MYDLjE::M::User>, L<MYDLjE::M::Session>, L<MYDLjE::M::Content>
589
590
591 =head1 AUTHOR AND COPYRIGHT
592
593 (c) 2011 Красимир Беров L<k.berov@gmail.com>
594
595 This code is licensed under LGPLv3.
596
597
Something went wrong with that request. Please try again.