File Coverage

blib/lib/Object/Simple.pm
Criterion Covered Total %
statement 153 189 80.9
branch 71 106 66.9
condition 7 9 77.7
subroutine 16 16 100.0
pod 2 4 50.0
total 249 324 76.8


line stmt bran cond sub pod time code
1             package Object::Simple;
2              
3             our $VERSION = '3.1801';
4              
5 1     1   14591 use strict;
  1         2  
  1         21  
6 1     1   3 use warnings;
  1         1  
  1         17  
7 1     1   3 use Scalar::Util ();
  1         4  
  1         16  
8              
9 1     1   2 no warnings 'redefine';
  1         1  
  1         23  
10              
11 1     1   4 use Carp ();
  1         2  
  1         137  
12              
13             sub import {
14 12     12   539 my $class = shift;
15            
16 12 100       860 return unless @_;
17              
18             # Caller
19 9         12 my $caller = caller;
20            
21             # No export syntax
22 9         5 my $no_export_syntax;
23 9 100       10 unless (grep { $_[0] eq $_ } qw/new attr class_attr dual_attr/) {
  36         47  
24 8         9 $no_export_syntax = 1;
25             }
26            
27             # Inheritance
28 9 100       13 if ($no_export_syntax) {
29 8         9 my $arg1 = shift;
30 8         6 my $arg2 = shift;
31            
32 8         8 my $base_class;
33 8 50       16 if (defined $arg1) {
34             # Option
35 8 100       21 if ($arg1 =~ /^-/) {
36 7 100       9 if ($arg1 eq '-base') {
37 6 100       9 if (defined $arg2) {
38 2         2 $base_class = $arg2;
39             }
40             }
41             else {
42 1         124 Carp::croak "'$arg1' is invalid option(Object::Simple::import())";
43             }
44             }
45             # Base class
46             else {
47 1         2 $base_class = $arg1;
48             }
49             }
50            
51             # Export has function
52 1     1   4 no strict 'refs';
  1         1  
  1         26  
53 1     1   2 no warnings 'redefine';
  1         1  
  1         200  
54 7     4   17 *{"${caller}::has"} = sub { attr($caller, @_) };
  7         23  
  4         14  
55            
56             # Inheritance
57 7 100       10 if ($base_class) {
58 3         4 my $base_class_path = $base_class;
59 3         6 $base_class_path =~ s/::|'/\//g;
60 3         238 require "$base_class_path.pm";
61 3         7 @{"${caller}::ISA"} = ($base_class);
  3         23  
62             }
63 4         2 else { @{"${caller}::ISA"} = ($class) }
  4         29  
64            
65             # strict!
66 7         21 strict->import;
67 7         396 warnings->import;
68             }
69            
70             # Export methods
71             else {
72 1         3 my @methods = @_;
73            
74             # Exports
75 1         2 my %exports = map { $_ => 1 } qw/new attr class_attr dual_attr/;
  4         6  
76            
77             # Export methods
78 1         3 for my $method (@methods) {
79              
80             # Can be Exported?
81             Carp::croak("Cannot export '$method'.")
82 4 50       8 unless $exports{$method};
83              
84 4         31 warn "function exporting of $method is DEPRECATED(Object::Simple)";
85            
86             # Export
87 1     1   7 no strict 'refs';
  1         2  
  1         287  
88 4         22 *{"${caller}::$method"} = \&{"$method"};
  4         2058  
  4         7  
89             }
90             }
91             }
92              
93             sub new {
94 36     36 1 5940 my $class = shift;
95 36 100 66     195 bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
  4 100       26  
96             }
97              
98             sub attr {
99 15     15 1 1410 my ($self, @args) = @_;
100            
101 15   66     62 my $class = ref $self || $self;
102            
103             # Fix argument
104 15 100       34 unshift @args, (shift @args, undef) if @args % 2;
105            
106 15         35 for (my $i = 0; $i < @args; $i += 2) {
107            
108 18 100       29 if ($i == 2) {
109 2         28 warn "The syntax of multiple key-value arguments is DEPRECATED(Object::Simple::has or Object::Simple::attr)";
110             }
111            
112             # Attribute name
113 18         50 my $attrs = $args[$i];
114 18 100       41 $attrs = [$attrs] unless ref $attrs eq 'ARRAY';
115            
116             # Default
117 18         22 my $default = $args[$i + 1];
118            
119 18         21 for my $attr (@$attrs) {
120              
121 21 50       74 Carp::croak qq{Attribute "$attr" invalid} unless $attr =~ /^[a-zA-Z_]\w*$/;
122              
123             # Header (check arguments)
124 21         36 my $code = "*{\"${class}::$attr\"} = sub {\n if (\@_ == 1) {\n";
125              
126             # No default value (return value)
127 21 100       29 unless (defined $default) { $code .= " return \$_[0]{'$attr'};" }
  7         13  
128              
129             # Default value
130             else {
131              
132 14 100 100     274 Carp::croak "Default has to be a code reference or constant value (${class}::$attr)"
133             if ref $default && ref $default ne 'CODE';
134              
135             # Return value
136 13         16 $code .= " return \$_[0]{'$attr'} if exists \$_[0]{'$attr'};\n";
137              
138             # Return default value
139 13         12 $code .= " return \$_[0]{'$attr'} = ";
140 13 100       20 $code .= ref $default eq 'CODE' ? '$default->($_[0]);' : '$default;';
141             }
142              
143             # Store value
144 20         22 $code .= "\n }\n \$_[0]{'$attr'} = \$_[1];\n";
145              
146             # Footer (return invocant)
147 20         17 $code .= " \$_[0];\n}";
148              
149             # We compile custom attribute code for speed
150 1     1   3 no strict 'refs';
  1         1  
  1         212  
151 20 50       39 warn "-- Attribute $attr in $class\n$code\n\n" if $ENV{OBJECT_SIMPLE_DEBUG};
152 20 50   6   1953 Carp::croak "Object::Simple error: $@" unless eval "$code;1";
  6 50       140  
  6 50       23  
  6 0       23  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  1 0       264  
  1 50       3  
  1 50       4  
  0 50       0  
  0 50       0  
  6 50       19  
  6 50       9  
  6 50       17  
  0 50       0  
  0 50       0  
  2 50       6  
  2 100       7  
  2 100       6  
  0 100       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 100       0  
  1 0       26  
  1 100       3  
  1 50       5  
  0 50       0  
  0 100       0  
  1         4  
  1         3  
  1         4  
  0         0  
  0         0  
  1         406  
  1         3  
  1         4  
  0         0  
  0         0  
  1         3  
  1         4  
  1         5  
  0         0  
  0         0  
  3         10  
  3         7  
  3         8  
  0         0  
  0         0  
  11         1141  
  8         34  
  3         5  
  3         6  
  5         78  
  3         9  
  2         12  
  2         3  
  2         6  
  1         5  
  1         7  
  1         5  
  0         0  
  0         0  
  1         3  
  1         4  
  1         59  
  0         0  
  0         0  
  2         6  
  1         4  
  1         2  
  1         2  
  0         0  
  0         0  
  0         0  
  0         0  
  2         43  
  1         5  
  1         3  
  1         2  
  2         5  
  2         5  
  2         5  
  0         0  
  0         0  
  2         41  
  1         5  
  1         6  
  1         1  
153             }
154             }
155             }
156              
157             # DEPRECATED!
158             sub class_attr {
159 13     13 0 1081 require Object::Simple::Accessor;
160 13         33 Object::Simple::Accessor::create_accessors('class_attr', @_)
161             }
162              
163             # DEPRECATED!
164             sub dual_attr {
165 12     12 0 372 require Object::Simple::Accessor;
166 12         23 Object::Simple::Accessor::create_accessors('dual_attr', @_)
167             }
168              
169             =head1 NAME
170              
171             Object::Simple - Simplest class builder, Mojo::Base porting, fast and less memory
172              
173             =over
174              
175             =item *
176              
177             B. All you learn is only C function!
178              
179             =item *
180              
181             B. Do you like L? If so, this is good choices!
182              
183             =item *
184              
185             B. Fast C and accessor method. Memory saving implementation.
186              
187             =back
188              
189             =head1 SYNOPSIS
190              
191             package SomeClass;
192             use Object::Simple -base;
193            
194             # Create accessor
195             has 'foo';
196            
197             # Create accessor with default value
198             has foo => 1;
199             has foo => sub { [] };
200             has foo => sub { {} };
201             has foo => sub { OtherClass->new };
202            
203             # Create accessors at once
204             has ['foo', 'bar', 'baz'];
205             has ['foo', 'bar', 'baz'] => 0;
206            
207             Create object.
208              
209             # Create a new object
210             my $obj = SomeClass->new;
211             my $obj = SomeClass->new(foo => 1, bar => 2);
212             my $obj = SomeClass->new({foo => 1, bar => 2});
213            
214             # Set and get value
215             my $foo = $obj->foo;
216             $obj->foo(1);
217            
218             # Setter can be chained
219             $obj->foo(1)->bar(2);
220              
221             Inheritance
222            
223             package Foo;
224             use Object::Simple -base;
225            
226             # Bar inherit Foo
227             package Bar;
228             use Object::Simple 'Foo';
229            
230             # Another way to inherit(This is Object::Simple original)
231             package Bar;
232             use Object::Simple -base => 'Foo';
233              
234             # Another way to inherit (This is Object::Simple original)
235             use Foo -base;
236              
237             =head1 DESCRIPTION
238              
239             Object::Simple is B class builder. All you learn is only C function.
240             You can learn all features of L in B. There is nothing difficult.
241              
242             Do you like L? In fact, Object::Simple is L porting. Mojo::Base is basic class builder in Mojolicious project.
243             If you like Mojolicious, this is good choice. If you have known Mojo::Base, you learn nothing.
244              
245             C and accessor method is B. Implementation is pure perl and plain old hash-base object.
246             Memory is saved. Extra objects is not created at all. Very light-weight object-oriented module.
247              
248             Comparison with L
249              
250             Class::Accessor::Fast is simple, but lack often used features.
251             C method can't receive hash arguments.
252             Default value can't be specified.
253             If multiple values is set through the accessor,
254             its value is converted to array reference without warnings.
255              
256             Comparison with L
257              
258             Moose has very complex syntax and depend on much many modules.
259             You have to learn many things to do object-oriented programing.
260             Understanding source code is difficult.
261             Compile-time is very slow and memory usage is very large.
262             Execution speed is not fast.
263             For simple OO, Moose is overkill.
264             L is improved in this point.
265              
266             =head1 TUTORIAL
267              
268             =head2 1. Create class and accessor
269              
270             At first, you create class.
271              
272             package SomeClass;
273             use Object::Simple -base;
274              
275             By using C<-base> option, SomeClass inherit Object::Simple and import C method.
276              
277             L have C method. C method is constructor.
278             C method can receive hash or hash reference.
279            
280             my $obj = SomeClass->new;
281             my $obj = SomeClass->new(foo => 1, bar => 2);
282             my $obj = SomeClass->new({foo => 1, bar => 2});
283              
284             Create accessor by using C function.
285              
286             has 'foo';
287              
288             If you create accessor, you can set or get value
289              
290             # Set value
291             $obj->foo(1);
292            
293             # Get value
294             my $foo = $obj->foo;
295              
296             Setter can be chained.
297              
298             $obj->foo(1)->bar(2);
299              
300             You can define default value.
301              
302             has foo => 1;
303              
304             If C value is not exists, default value is used.
305              
306             my $foo_default = $obj->foo;
307              
308             If you want to use reference or object as default value,
309             default value must be surrounded by code reference.
310             the return value become default value.
311              
312             has foo => sub { [] };
313             has foo => sub { {} };
314             has foo => sub { SomeClass->new };
315              
316             You can create multiple accessors at once.
317              
318             has ['foo', 'bar', 'baz'];
319             has ['foo', 'bar', 'baz'] => 0;
320              
321             =head2 2. Override method
322              
323             Method can be overridden.
324              
325             B
326              
327             Initialize the object
328              
329             sub new {
330             my $self = shift->SUPER::new(@_);
331            
332             # Initialization
333            
334             return $self;
335             }
336              
337             B
338              
339             Change arguments of C.
340            
341             sub new {
342             my $self = shift;
343            
344             $self->SUPER::new(x => $_[0], y => $_[1]);
345            
346             return $self;
347             }
348              
349             You can pass array to C method.
350              
351             my $point = Point->new(4, 5);
352              
353             =head2 3. Examples - class, accessor, inheritance and method overriding
354              
355             I introduce L example.
356              
357             Point class: two accessor C and C,
358             and C method to set C and C to 0.
359              
360             package Point;
361             use Object::Simple -base;
362              
363             has x => 0;
364             has y => 0;
365            
366             sub clear {
367             my $self = shift;
368            
369             $self->x(0);
370             $self->y(0);
371             }
372              
373             Use Point class.
374              
375             use Point;
376             my $point = Point->new(x => 3, y => 5);
377             print $point->x;
378             $point->y(9);
379             $point->clear;
380              
381             Point3D class: Point3D inherit Point class.
382             Point3D class has C accessor in addition to C and C.
383             C method is overridden to clear C, C and C.
384              
385             package Point3D;
386             use Object::Simple 'Point';
387            
388             has z => 0;
389            
390             sub clear {
391             my $self = shift;
392            
393             $self->SUPER::clear;
394            
395             $self->z(0);
396             }
397              
398             Use Point3D class.
399              
400             use Point3D;
401             my $point = Point->new(x => 3, y => 5, z => 8);
402             print $point->z;
403             $point->z(9);
404             $point->clear;
405              
406             =head1 WHAT IS OBJECT-ORIENTED PROGRAMING?
407              
408             I introduce essence of Object-Oriented programing.
409              
410             =head2 1. Inheritance
411              
412             First concept is inheritance.
413             Inheritance means that
414             if Class Q inherit Class P, Class Q call all methods of class P.
415              
416             +---+
417             | P | Base class
418             +---+ have method1 and method2
419             |
420             +---+
421             | Q | Sub class
422             +---+ have method3
423              
424             Class Q inherits Class P,
425             Q can call all methods of P in addition to methods of Q.
426              
427             In other words, Q can call
428             C, C, and C
429              
430             You can inherit other class by the following way.
431              
432             # P.pm
433             package P;
434             use Object::Simple -base;
435            
436             sub method1 { ... }
437             sub method2 { ... }
438            
439             # Q.pm
440             package Q;
441             use Object::Simple 'P';
442            
443             sub method3 { ... }
444              
445             Perl have useful functions and methods to help Object-Oriented programing.
446              
447             If you know what class the object is belonged to, use C function.
448              
449             my $class = ref $obj;
450              
451             If you know what class the object inherits, use C method.
452              
453             $obj->isa('SomeClass');
454              
455             If you know what method the object(or class) can use, use C method
456              
457             SomeClass->can('method1');
458             $obj->can('method1');
459              
460             =head2 2. Encapsulation
461              
462             Second concept is encapsulation.
463             Encapsulation means that
464             you don't touch internal data directory.
465             You must use public method when you access internal data.
466              
467             Create accessor and use it to keep this rule.
468              
469             my $value = $obj->foo;
470             $obj->foo(1);
471              
472             =head2 3. Polymorphism
473              
474             Third concept is polymorphism.
475             Polymorphism is divided into two concepts,
476             overload and override
477              
478             Perl programmer don't need to care overload.
479             Perl is dynamic type language.
480             Subroutine can receive any value.
481              
482             Override means that you can change method behavior in sub class.
483            
484             # P.pm
485             package P;
486             use Object::Simple -base;
487            
488             sub method1 { return 1 }
489            
490             # Q.pm
491             package Q;
492             use Object::Simple 'P';
493            
494             sub method1 { return 2 }
495              
496             P C return 1. Q C return 2.
497             Q C override P C.
498              
499             # P method1 return 1
500             my $obj_a = P->new;
501             $obj_p->method1;
502            
503             # Q method1 return 2
504             my $obj_b = Q->new;
505             $obj_q->method1;
506              
507             If you want to call super class method from sub class,
508             use SUPER pseudo-class.
509              
510             package Q;
511             use Object::Simple 'P';
512            
513             sub method1 {
514             my $self = shift;
515            
516             # Call supper class P method1
517             my $value = $self->SUPER::method1;
518            
519             return 2 + $value;
520             }
521              
522             If you understand three concepts,
523             you have learned Object-Oriented programming primary parts.
524              
525             =head1 FUNCTIONS
526              
527             =head2 has
528              
529             Create accessor.
530            
531             has 'foo';
532             has ['foo', 'bar', 'baz'];
533             has foo => 1;
534             has foo => sub { {} };
535              
536             has ['foo', 'bar', 'baz'];
537             has ['foo', 'bar', 'baz'] => 0;
538              
539             C function receive
540             accessor name and default value.
541             Default value is optional.
542             If you want to create multiple accessors at once,
543             specify accessor names as array reference at first argument.
544              
545             If you want to specify reference or object as default value,
546             it must be code reference
547             not to share the value with other objects.
548              
549             Get and set a value.
550              
551             my $foo = $obj->foo;
552             $obj->foo(1);
553              
554             If a default value is specified and the value is not exists,
555             you can get default value.
556              
557             Setter return invocant. so you can do chained call.
558              
559             $obj->foo(1)->bar(2);
560              
561             =head1 METHODS
562              
563             =head2 new
564              
565             my $obj = Object::Simple->new;
566             my $obj = Object::Simple->new(foo => 1, bar => 2);
567             my $obj = Object::Simple->new({foo => 1, bar => 2});
568              
569             Create a new object. C receive
570             hash or hash reference as arguments.
571              
572             =head2 attr
573              
574             __PACKAGE__->attr('foo');
575             __PACKAGE__->attr(['foo', 'bar', 'baz']);
576             __PACKAGE__->attr(foo => 1);
577             __PACKAGE__->attr(foo => sub { {} });
578              
579             __PACKAGE__->attr(['foo', 'bar', 'baz']);
580             __PACKAGE__->attr(['foo', 'bar', 'baz'] => 0);
581              
582             Create accessor.
583             C method usage is equal to C function.
584              
585             =head1 OPTIONS
586              
587             =head2 -base
588              
589             By using C<-base> option, the class inherit Object::Simple
590             and import C function.
591              
592             package Foo;
593             use Object::Simple -base;
594            
595             has x => 1;
596             has y => 2;
597              
598             strict and warnings is automatically enabled.
599              
600             If you want to inherit class, let's write the following way.
601            
602             # Bar inherit Foo
603             package Bar;
604             use Object::Simple 'Foo';
605              
606             You can also use the following syntax. This is Object::Simple only.
607              
608             # Same as above
609             package Bar;
610             use Object::Simple -base => 'Foo';
611              
612             You can also use C<-base> option in sub class
613             to inherit other class. This is Object::Simple only.
614              
615             # Same as above
616             package Bar;
617             use Foo -base;
618              
619             =head1 FAQ
620              
621             =head2 Really enough object-oriented programing with this few features?
622              
623             Yes, for example, Mojolicious is very big project, but in fact, source code is clean only using single inheritance.
624             Generally speaking, readable source code is build on simple concepts, not complex features.
625              
626             C, C and C methods in L are needed for good object-oriented programming?
627             If you want to use multiple inheritance or role, these methods is needed.
628              
629             But I strongly recommend you use only single inheritance in object-oriented programming. Single inheritance is clean and readable.
630              
631             If you use only single inheritance,
632             You can create custom constructor and call constructors in correct order.
633             and You can create custom destructor and call destructors in correct order,
634              
635             Creating custom constructor is very very easy. There is nothing difficult.
636            
637             # Custom constructor
638             sub new {
639             # At first Call super class constructor. Next do what you want
640             my $self = shift->SUPER::new(@_);
641            
642             # What you want
643            
644             return $self;
645             }
646            
647             # Custom destructor
648             sub DESTROY {
649             my $self = shift;
650            
651             # What you want
652              
653             # At first, do what you want, Next call super class destructor
654             $selft->SUPER::DESTROY;
655            
656             return $self;
657             }
658              
659             =head2 Object::Simple is fastest OO module?
660              
661             No, Object::Simple is B fastest module, but enough fast. If you really need performance, you can access hash value directory.
662              
663             # I want performance in some places. Let's access hash value directory!
664             # Object::Simple is plain old hash-based object
665             $self->{x};
666              
667             =head2 What is benefits comparing with Mojo::Base?
668              
669             =over
670              
671             =item *
672              
673             Support Perl 5.8
674              
675             =item *
676              
677             Installation is very fast because there are a few files.
678              
679             =item *
680              
681             Some people think that my module want not to depend on whole Mojolicious to use Mojo::Base only. Object::Simple satisfy the demand.
682              
683             =head2 Why Object::Simple is different from Mojo::Base in some points?
684              
685             In old days, Object::Simple wasn't Mojo::Base porting. I tried different things.
686              
687             Now, I want Object::Simple to be same as Mojo::Base completely except supporting Perl 5.8.
688              
689             =back
690              
691             =head1 BACKWARDS COMPATIBILITY POLICY
692              
693             If a functionality is DEPRECATED, you can know it by DEPRECATED warnings.
694             You can check all DEPRECATED functionalities by document.
695             DEPRECATED functionality is removed after five years,
696             but if at least one person use the functionality and tell me that thing
697             I extend one year each time he tell me it.
698              
699             EXPERIMENTAL functionality will be changed without warnings.
700              
701             (This policy was changed at 2011/10/22)
702              
703             =head1 DEPRECATED
704              
705             function exporting of C and C method # Will be removed 2021/6/1
706            
707             The syntax of multiple key-value arguments
708             has x => 1, y => 2;
709             __PACAKGE__->attr(x => 1, y => 2);
710             # Will be removed 2021/6/1
711            
712             class_attr method # will be removed 2017/1/1
713             dual_attr method # will be removed 2017/1/1
714              
715             =head1 BUGS
716              
717             Tell me the bugs
718             by mail(C<< >>) or github L
719              
720             =head1 AUTHOR
721              
722             Yuki Kimoto(C<< >>)
723              
724             I'm pleasure if you send message for cheer. I can get power by only your messages!
725              
726             =head1 USERS
727              
728             Projects using L.
729              
730             =over 4
731              
732             =item *
733              
734             GitPrep - Portable GitHub system into your own server. L
735              
736             =item *
737              
738             L - DBI extension to execute insert, update, delete, and select easily
739              
740             =item *
741              
742             L - HTML form Validation, simple and good flexibility
743              
744             =back
745              
746             =head1 SEE ALSO
747              
748             CPAN have various class builders. Let's compare it with L.
749              
750             L, L, L, L, L, L.
751              
752             =head1 COPYRIGHT & LICENSE
753              
754             Copyright 2008-2016 Yuki Kimoto, all rights reserved.
755              
756             This program is free software; you can redistribute it and/or modify it
757             under the same terms as Artistic v2.
758              
759             This is same as L licence.
760              
761             =cut
762              
763             1;