| File: | blib/lib/Simo.pm |
| Coverage: | 84.9% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Simo; | ||||||
| 2 | 12 12 12 | 0 0 0 | use strict; | ||||
| 3 | 12 12 11 | 0 0 0 | use warnings; | ||||
| 4 | 11 12 11 | 0 0 0 | use Carp; | ||||
| 5 | |||||||
| 6 | our $VERSION = '0.05_05'; | ||||||
| 7 | |||||||
| 8 | sub import{ | ||||||
| 9 | 24 | 0 | my $caller_pkg = caller; | ||||
| 10 | |||||||
| 11 | { | ||||||
| 12 | # export function | ||||||
| 13 | 11 11 11 24 | 0 0 0 0 | no strict 'refs'; | ||||
| 14 | 24 24 | 0 0 | *{ "${caller_pkg}::ac" } = \&Simo::ac; | ||||
| 15 | |||||||
| 16 | # caller inherit Simo | ||||||
| 17 | 24 24 | 0 0 | push @{ "${caller_pkg}::ISA" }, __PACKAGE__; | ||||
| 18 | } | ||||||
| 19 | |||||||
| 20 | # auto strict and warnings | ||||||
| 21 | 24 | 0 | strict->import; | ||||
| 22 | 24 | 0 | warnings->import; | ||||
| 23 | } | ||||||
| 24 | |||||||
| 25 | sub new{ | ||||||
| 26 | 26 | 1 | 0 | my ( $proto, @args ) = @_; | |||
| 27 | |||||||
| 28 | # check args | ||||||
| 29 | 26 1 | 0 0 | @args = %{ $args[0] } if ref $args[0] eq 'HASH'; | ||||
| 30 | 26 | 0 | croak 'key-value pairs must be passed to new method' if @args % 2; | ||||
| 31 | |||||||
| 32 | # bless | ||||||
| 33 | 25 | 0 | my $self = {}; | ||||
| 34 | 25 | 10000 | my $pkg = ref $proto || $proto; | ||||
| 35 | 25 | 0 | bless $self, $pkg; | ||||
| 36 | |||||||
| 37 | # set args | ||||||
| 38 | 25 | 0 | while( my ( $attr, $val ) = splice( @args, 0, 2 ) ){ | ||||
| 39 | 8 | 0 | croak "Invalid key '$attr' is passed to ${pkg}::new" unless $self->can( $attr ); | ||||
| 40 | 11 11 11 | 10000 0 0 | no strict 'refs'; | ||||
| 41 | 7 | 0 | $self->$attr( $val ); | ||||
| 42 | } | ||||||
| 43 | 24 | 0 | return $self; | ||||
| 44 | } | ||||||
| 45 | |||||||
| 46 | # accessor option | ||||||
| 47 | our $AC_OPT = {}; | ||||||
| 48 | our %VALID_AC_OPT = map{ $_ => 1 } qw( default constrain filter trigger set_hook get_hook hash_force read_only ); | ||||||
| 49 | |||||||
| 50 | # create accessor | ||||||
| 51 | sub ac(@){ | ||||||
| 52 | # Simo process | ||||||
| 53 | 40 | 1 | 20001 | my ( $self, $attr, @vals ) = _SIMO_process( @_ ); | |||
| 54 | |||||||
| 55 | # call accessor | ||||||
| 56 | 36 | 0 | $self->$attr( @vals ); | ||||
| 57 | } | ||||||
| 58 | |||||||
| 59 | # Simo process. register accessor option and create accessor. | ||||||
| 60 | sub _SIMO_process{ | ||||||
| 61 | # accessor info | ||||||
| 62 | 40 | 0 | my ( $self, $attr, $pkg, @vals ) = _SIMO_get_ac_info(); | ||||
| 63 | |||||||
| 64 | # check and rearrange accessor option; | ||||||
| 65 | 40 | 10001 | my $ac_opt = {}; | ||||
| 66 | |||||||
| 67 | 40 | 0 | $ac_opt->{ default } = shift if @_ % 2; | ||||
| 68 | 40 | 0 | my $hook_options_exist = {}; | ||||
| 69 | |||||||
| 70 | 40 | 0 | while( my( $key, $val ) = splice( @_, 0, 2 ) ){ | ||||
| 71 | 36 | 0 | croak "$key of ${pkg}::$attr is invalid accessor option" | ||||
| 72 | unless $VALID_AC_OPT{ $key }; | ||||||
| 73 | |||||||
| 74 | 35 | 0 | carp "${pkg}::$attr : $@" | ||||
| 75 | unless _SIMO_check_hook_options_order( $key, $hook_options_exist ); | ||||||
| 76 | |||||||
| 77 | 35 | 0 | $ac_opt->{ $key } = $val; | ||||
| 78 | } | ||||||
| 79 | |||||||
| 80 | # register accessor option | ||||||
| 81 | 39 | 0 | $AC_OPT->{ $pkg }{ $attr } = $ac_opt; | ||||
| 82 | |||||||
| 83 | # create accessor | ||||||
| 84 | { | ||||||
| 85 | 11 11 11 39 | 0 0 0 0 | no warnings 'redefine'; | ||||
| 86 | 39 | 0 | my $code = _SIMO_create_accessor( $pkg, $attr ); | ||||
| 87 | 36 5 5 5 2 2 3 9 9 5 9 9 5 4 8 3 3 3 2 2 1 1 0 1 1 1 0 2 2 3 2 2 3 2 2 1 2 2 3 3 1 3 3 1 2 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 2 2 2 1 1 2 2 2 2 23 23 21 14 14 15 8 16 9 5 5 9 3 2 2 2 1 1 1 1 1 2 2 2 2 2 2 2 2 2 1 1 1 2 2 0 2 2 1 1 2 2 2 2 1 1 1 1 1 1 2 2 2 2 1 1 1 1 1 1 2 1 1 1 1 1 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 0 0 1 2 2 2 1 1 1 1 1 1 2 2 2 2 1 1 1 1 2 2 2 2 2 2 2 2 2 4 4 3 1 1 2 2 2 1 1 1 2 2 1 2 | 20000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 | eval"sub ${pkg}::${attr} $code"; | ||||
| 88 | } | ||||||
| 89 | 36 | 0 | return ( $self, $attr, @vals ); | ||||
| 90 | } | ||||||
| 91 | |||||||
| 92 | # check hook option order ( constrain, filter, and trigger ) | ||||||
| 93 | our %VALID_HOOK_OPT = ( constrain => 1, filter => 2, trigger => 3 ); | ||||||
| 94 | |||||||
| 95 | sub _SIMO_check_hook_options_order{ | ||||||
| 96 | 35 | 0 | my ( $key, $hook_options_exist ) = @_; | ||||
| 97 | |||||||
| 98 | 35 | 0 | return 1 unless $VALID_HOOK_OPT{ $key }; | ||||
| 99 | |||||||
| 100 | 23 23 | 0 0 | foreach my $hook_option_exist ( keys %{ $hook_options_exist } ){ | ||||
| 101 | 6 | 0 | if( $VALID_HOOK_OPT{ $key } < $VALID_HOOK_OPT{ $hook_option_exist } ){ | ||||
| 102 | 3 | 0 | $@ = "$key option should be appear before $hook_option_exist option"; | ||||
| 103 | 3 | 0 | return 0; | ||||
| 104 | } | ||||||
| 105 | } | ||||||
| 106 | 20 | 0 | $hook_options_exist->{ $key } = 1; | ||||
| 107 | 20 | 0 | return 1; | ||||
| 108 | } | ||||||
| 109 | |||||||
| 110 | # create accessor. | ||||||
| 111 | sub _SIMO_create_accessor{ | ||||||
| 112 | 39 | 0 | my ( $pkg, $attr ) = @_; | ||||
| 113 | |||||||
| 114 | 39 | 0 | my $read_only = $AC_OPT->{ $pkg }{ $attr }{ read_only }; | ||||
| 115 | |||||||
| 116 | 39 | 0 | if( $read_only ){ | ||||
| 117 | 2 | 0 | my $attr_org = $attr; | ||||
| 118 | 2 | 0 | if( $attr =~ s/get_// ){ | ||||
| 119 | 1 | 0 | $AC_OPT->{ $pkg }{ $attr } = delete $AC_OPT->{ $pkg }{ $attr_org } | ||||
| 120 | } | ||||||
| 121 | else{ | ||||||
| 122 | 1 | 0 | Carp::carp( "Read only method should be contain 'get_' in accessor name" ) | ||||
| 123 | } | ||||||
| 124 | } | ||||||
| 125 | |||||||
| 126 | 39 | 0 | my $e = | ||||
| 127 | qq/{\n/ . | ||||||
| 128 | # arg recieve | ||||||
| 129 | qq/ my ( \$self, \@vals ) = \@_;\n\n/; | ||||||
| 130 | |||||||
| 131 | 39 | 10001 | if( defined $AC_OPT->{ $pkg }{ $attr }{ default } ){ | ||||
| 132 | # default value | ||||||
| 133 | 13 | 0 | $e .= | ||||
| 134 | qq/ if( ! exists( \$self->{ $attr } ) ){\n/ . | ||||||
| 135 | qq/ \$self->{ $attr } = \$AC_OPT->{ $pkg }{ $attr }{ default };\n/ . | ||||||
| 136 | qq/ }\n/ . | ||||||
| 137 | qq/ \n/; | ||||||
| 138 | } | ||||||
| 139 | |||||||
| 140 | # get value | ||||||
| 141 | $e .= | ||||||
| 142 | 39 | 0 | qq/ my \$ret = \$self->{ $attr };\n\n/; | ||||
| 143 | |||||||
| 144 | |||||||
| 145 | # read only | ||||||
| 146 | 39 2 | 0 0 | if( $read_only ){ goto END_SET_PROCESS } | ||||
| 147 | |||||||
| 148 | $e .= | ||||||
| 149 | 37 | 0 | qq/ if( \@vals ){\n/ . | ||||
| 150 | |||||||
| 151 | # rearrange value | ||||||
| 152 | qq/ my \$val = \@vals == 1 ? \$vals[0] :\n/; | ||||||
| 153 | $e .= $AC_OPT->{ $pkg }{ $attr }{ hash_force } ? | ||||||
| 154 | 37 | 0 | qq/ \@vals >= 2 ? { \@vals } :\n/ : | ||||
| 155 | qq/ \@vals >= 2 ? [ \@vals ] :\n/; | ||||||
| 156 | 37 | 0 | $e .= | ||||
| 157 | qq/ undef;\n\n/; | ||||||
| 158 | |||||||
| 159 | 37 | 0 | if( defined $AC_OPT->{ $pkg }{ $attr }{ set_hook } ){ | ||||
| 160 | # set_hook option | ||||||
| 161 | 2 | 0 | $e .= | ||||
| 162 | qq/ eval{ \$val = \$AC_OPT->{ $pkg }{ $attr }{ set_hook }->( \$self, \$val ) };\n/ . | ||||||
| 163 | qq/ Carp::confess( \$@ ) if \$@;\n\n/; | ||||||
| 164 | } | ||||||
| 165 | |||||||
| 166 | 37 | 0 | if( defined $AC_OPT->{ $pkg }{ $attr }{ constrain } ){ | ||||
| 167 | # constrain option | ||||||
| 168 | |||||||
| 169 | $AC_OPT->{ $pkg }{ $attr }{ constrain } = [ $AC_OPT->{ $pkg }{ $attr }{ constrain } ] | ||||||
| 170 | 9 | 0 | unless ref $AC_OPT->{ $pkg }{ $attr }{ constrain } eq 'ARRAY'; | ||||
| 171 | |||||||
| 172 | 9 9 | 0 0 | foreach my $constrain ( @{ $AC_OPT->{ $pkg }{ $attr }{ constrain } } ){ | ||||
| 173 | 10 | 0 | Carp::croak( "constrain of ${pkg}::$attr must be code ref" ) | ||||
| 174 | unless ref $constrain eq 'CODE'; | ||||||
| 175 | } | ||||||
| 176 | |||||||
| 177 | $e .= | ||||||
| 178 | 8 | 0 | qq/ foreach my \$constrain ( \@{ \$AC_OPT->{ $pkg }{ $attr }{ constrain } } ){\n/ . | ||||
| 179 | qq/ local \$_ = \$val;\n/ . | ||||||
| 180 | qq/ my \$ret = \$constrain->( \$val );\n/ . | ||||||
| 181 | qq/ Carp::croak( "Illegal value \$val is passed to ${pkg}::$attr" )\n/ . | ||||||
| 182 | qq/ unless \$ret;\n/ . | ||||||
| 183 | qq/ }\n\n/; | ||||||
| 184 | } | ||||||
| 185 | |||||||
| 186 | 36 | 0 | if( defined $AC_OPT->{ $pkg }{ $attr }{ filter } ){ | ||||
| 187 | # filter option | ||||||
| 188 | $AC_OPT->{ $pkg }{ $attr }{ filter } = [ $AC_OPT->{ $pkg }{ $attr }{ filter } ] | ||||||
| 189 | 7 | 0 | unless ref $AC_OPT->{ $pkg }{ $attr }{ filter } eq 'ARRAY'; | ||||
| 190 | |||||||
| 191 | 7 7 | 0 0 | foreach my $filter ( @{ $AC_OPT->{ $pkg }{ $attr }{ filter } } ){ | ||||
| 192 | 8 | 0 | Carp::croak( "filter of ${pkg}::$attr must be code ref" ) | ||||
| 193 | unless ref $filter eq 'CODE'; | ||||||
| 194 | } | ||||||
| 195 | |||||||
| 196 | $e .= | ||||||
| 197 | 6 | 0 | qq/ foreach my \$filter ( \@{ \$AC_OPT->{ $pkg }{ $attr }{ filter } } ){\n/ . | ||||
| 198 | qq/ local \$_ = \$val;\n/ . | ||||||
| 199 | qq/ \$val = \$filter->( \$val );\n/ . | ||||||
| 200 | qq/ }\n\n/; | ||||||
| 201 | } | ||||||
| 202 | |||||||
| 203 | # set value | ||||||
| 204 | $e .= | ||||||
| 205 | 35 | 0 | qq/ \$self->{ $attr } = \$val;\n\n/; | ||||
| 206 | |||||||
| 207 | 35 | 0 | if( defined $AC_OPT->{ $pkg }{ $attr }{ trigger } ){ | ||||
| 208 | $AC_OPT->{ $pkg }{ $attr }{ trigger } = [ $AC_OPT->{ $pkg }{ $attr }{ trigger } ] | ||||||
| 209 | 7 | 0 | unless ref $AC_OPT->{ $pkg }{ $attr }{ trigger } eq 'ARRAY'; | ||||
| 210 | |||||||
| 211 | 7 7 | 0 0 | foreach my $trigger ( @{ $AC_OPT->{ $pkg }{ $attr }{ trigger } } ){ | ||||
| 212 | 8 | 0 | Carp::croak( "trigger of ${pkg}::$attr must be code ref" ) | ||||
| 213 | unless ref $trigger eq 'CODE'; | ||||||
| 214 | } | ||||||
| 215 | |||||||
| 216 | # trigger option | ||||||
| 217 | $e .= | ||||||
| 218 | 6 | 0 | qq/ foreach my \$trigger ( \@{ \$AC_OPT->{ $pkg }{ $attr }{ trigger } } ){\n/ . | ||||
| 219 | qq/ local \$_ = \$self;\n/ . | ||||||
| 220 | qq/ \$trigger->( \$self );\n/ . | ||||||
| 221 | qq/ }\n/; | ||||||
| 222 | } | ||||||
| 223 | |||||||
| 224 | $e .= | ||||||
| 225 | 34 | 0 | qq/ }\n/; | ||||
| 226 | |||||||
| 227 | END_SET_PROCESS: | ||||||
| 228 | |||||||
| 229 | 36 | 0 | if( defined $AC_OPT->{ $pkg }{ $attr }{ get_hook } ){ | ||||
| 230 | # get_hook option | ||||||
| 231 | 2 | 0 | $e .= | ||||
| 232 | qq/ eval{ \$ret = \$AC_OPT->{ $pkg }{ $attr }{ get_hook }->( \$self, \$ret ) };\n/ . | ||||||
| 233 | qq/ Carp::confess( \$@ ) if \$@;\n/; | ||||||
| 234 | } | ||||||
| 235 | |||||||
| 236 | #return | ||||||
| 237 | $e .= | ||||||
| 238 | 36 | 0 | qq/ return \$ret;\n/ . | ||||
| 239 | qq/}\n/; | ||||||
| 240 | |||||||
| 241 | 36 | 0 | return $e; | ||||
| 242 | } | ||||||
| 243 | |||||||
| 244 | # Helper to get acsessor info; | ||||||
| 245 | sub _SIMO_get_ac_info { | ||||||
| 246 | package DB; | ||||||
| 247 | 40 | 0 | my @caller = caller 3; | ||||
| 248 | |||||||
| 249 | 40 | 0 | my ( $self, @vals ) = @DB::args; | ||||
| 250 | 40 | 0 | my $sub = $caller[ 3 ]; | ||||
| 251 | 40 | 0 | my ( $pkg, $attr ) = $sub =~ /^(.*)::(.+)$/; | ||||
| 252 | |||||||
| 253 | 40 | 0 | return ( $self, $attr, $pkg, @vals ); | ||||
| 254 | } | ||||||
| 255 | |||||||
| 256 - 264 | =head1 NAME Simo - Very simple framework for Object Oriented Perl. =head1 VERSION Version 0.05_05 =cut | ||||||
| 265 | |||||||
| 266 - 287 | =head1 FEATURES Simo is framework that simplify Object Oriented Perl. The feature is that =over 4 =item 1. You can define accessors in very simple way. =item 2. Overridable new method is prepared. =item 3. You can define default value of attribute. =item 4. Simo is very small. so You can install and excute it very fast. =back If you use Simo, you are free from bitter work writing new and accessors repeatedly. =cut | ||||||
| 288 | |||||||
| 289 - 322 | =head1 SYNOPSIS
=head2 Define class and accessors.
package Book;
use Simo;
# define accessors
sub title{ ac }
# define default value
sub author{ ac default => 'Kimoto' }
# define constrain subroutine
sub price{ ac constrain => sub{ /^\d+$/ } } # price must be integer.
# define filter subroutine
sub description{ ac filter => sub{ uc } } # convert to upper case.
# define trigger subroutine
sub issue_datetime{ ac trigger => \&update_issue_date }
sub issue_date{ ac } # if issue_datetime is updated, issue_date is updated.
sub update_issue_date{
my $self = shift;
my $date = substr( $self->issue_datetime, 0, 10 );
$self->issue_date( $date );
}
# read only accessor
sub get_size{ ac default => 5, read_only => 1 }
1;
=cut | ||||||
| 323 | |||||||
| 324 - 352 | =head2 Using class and accessors
use strict;
use warnings;
use Book;
# create object
my $book = Book->new( title => 'OO tutorial' );
# get attribute
my $author = $book->author;
# set attribute
$book->author( 'Ken' );
# constrain( If try to set illegal value, this call will die )
$book->price( 'a' );
# filter ( convert to 'IT IS USEFUL' )
$book->description( 'It is useful' );
# trigger( issue_date is updated '2009-01-01' )
$book->issue_datetime( '2009-01-01 12:33:45' );
my $issue_date = $book->issue_date;
# read only accessor
$book->get_size;
=cut | ||||||
| 353 | |||||||
| 354 - 368 | =head1 DESCRIPTION
=head2 Define class and accessors
You can define class and accessors in simple way.
new method is automatically created, and title accessor is defined.
package Book;
use Simo;
sub title{ ac }
1;
=cut | ||||||
| 369 | |||||||
| 370 - 387 | =head2 Using class and accessors
You can pass key-value pairs to new, and can get and set value.
use Book;
# create object
my $book = Book->new(
title => 'OO tutorial',
);
# get value
my $title = $book->title;
# set value
$book->title( 'The simplest OO' );
=cut | ||||||
| 388 | |||||||
| 389 - 396 | =head2 Automatically array convert
If you pass array to accessor, array convert to array ref.
$book->title( 'a', 'b' );
$book->title; # get [ 'a', 'b' ], not ( 'a', 'b' )
=cut | ||||||
| 397 | |||||||
| 398 - 406 | =head2 Accessor options
=head3 default option
You can define default value of attribute.
sub title{ ac default => 'Perl is very interesting' }
=cut | ||||||
| 407 | |||||||
| 408 - 440 | =head3 constrain option
you can constrain setting value.
sub price{ ac constrain => sub{ /^\d+$/ } }
For example, If you call $book->price( 'a' ), this call is die, because 'a' is not number.
'a' is set to $_. so if you can use regular expression, omit $_.
you can write not omiting $_.
sub price{ ac constrain => sub{ $_ > 0 && $_ < 3 } }
If you display your message when program is die, you call craok.
use Carp;
sub price{ ac constrain => sub{ $_ > 0 && $_ < 3 or croak "Illegal value" } }
and 'a' is alse set to first argument. So you can receive 'a' as first argument.
sub price{ ac constrain => \&_is_number }
sub _is_number{
my $val = shift;
return $val =~ /^\d+$/;
}
and you can define more than one constrain.
sub price{ ac constrain => [ \&_is_number, \&_is_non_zero ] }
=cut | ||||||
| 441 | |||||||
| 442 - 454 | =head3 filter option
you can filter setting value.
sub description{ ac filter => sub{ uc } }
setting value is $_ and frist argument like constrain.
and you can define more than one filter.
sub description{ ac filter => [ \&uc, \&quoute ] }
=cut | ||||||
| 455 | |||||||
| 456 - 477 | =head3 trigger option
You can define subroutine called after value is set.
For example, issue_datetime is set, issue_date is update.
$self is set to $_ and $_[0] different from constrain and filter.
sub issue_datetime{ ac trigger => \&update_issue_date }
sub issue_date{ ac }
sub update_issue_date{
my $self = shift;
my $date = substr( $self->issue_datetime, 0, 10 );
$self->issue_date( $date );
}
and you can define more than one trigger.
sub issue_datetime{ ac trigger => [ \&update_issue_date, \&update_issue_time ] }
=cut | ||||||
| 478 | |||||||
| 479 - 503 | =head3 read_only option
Read only accessor is defined
sub get_size{ ac default => 5, read_only => 1 }
Accessor name should be contain 'get_'. If not, warning is happen.
=head3 hash_force option
If you pass array to accessor, Normally list convert to array ref.
$book->title( 'a' , 'b' ); # convert to [ 'a', 'b' ]
Even if you write
$book->title( a => 'b' )
( a => 'b' ) converted to [ 'a', 'b' ]
If you use hash_force option, you convert list to hash ref
sub country_id{ ac hash_force => 1 }
$book->title( a => 'b' ); # convert to { a => 'b' }
=cut | ||||||
| 504 | |||||||
| 505 - 509 | =head3 set_hook option set_hook option is now not recommended. this option will be deleted in future 2019/01/01 =cut | ||||||
| 510 | |||||||
| 511 - 515 | =head3 get_hook option get_hook option is now not recommended. this option will be deleted in future 2019/01/01 =cut | ||||||
| 516 | |||||||
| 517 - 537 | =head2 Order of constrain, filter and trigger
=over 4
=item 1. val is passed to constrain subroutine.
=item 2. val is passed to filter subroutine.
=item 3. val is set
=item 4. trigger subroutine is called
=back
|---------| |------| |-------|
| | | | | |
val-->|constrain|-->|filter|-->(val is set)-->|trigger|
| | | | | |
|---------| |------| |-------|
=cut | ||||||
| 538 | |||||||
| 539 - 546 | =head2 Get old value
You can get old value when you use accessor as setter.
$book->author( 'Ken' );
my $old_value = $book->author( 'Taro' ); # $old_value is 'Ken'
=cut | ||||||
| 547 | |||||||
| 548 - 554 | =head1 FUNCTIONS =head2 ac ac is exported. This is used by define accessor. =cut | ||||||
| 555 | |||||||
| 556 - 560 | =head2 new orveridable new method. =cut | ||||||
| 561 | |||||||
| 562 | |||||||
| 563 - 597 | =head1 MORE TECHNIQUES
I teach you useful techniques.
=head2 New method overriding
by default, new method receive key-value pairs.
But you can change this action by overriding new method.
For example, Point class. You want to call new method this way.
my $point = Point->new( 3, 5 ); # xPos and yPos
You can override new method.
package Point;
use Simo;
sub new{
my ( $self, $x, $y ) = @_; # two arg( not key-value pairs )
# You can do anything if you need
return $self->SUPER::new( x => $x, y => $y );
}
sub x{ ac }
sub y{ ac }
1;
Simo implement inheritable new method.
Whenever You change argments or add initializetion,
You override new method.
=cut | ||||||
| 598 | |||||||
| 599 - 637 | =head2 Extend base class
you may want to extend base class. It is OK.
But I should say to you that there are one thing you should know.
The order of Inheritance is very important.
I write good sample and bad sample.
# base class
package Book;
sub title{ ac };
# Good sample.
# inherit base class. It is OK!
package Magazine;
use base 'Book'; # use base is first
use Simo; # use Simo is second;
# Bad sample
package Magazine;
use Simo; # use Simo is first
use base 'Book'; # use base is second
If you call new method in Good sample, you call Book::new method.
This is what you wanto to do.
If you call new method in Bad sample, you call Simo::new method.
you will think why Book::new method is not called?
Maybe, You will be wrong sometime. So I recomend you the following writing.
package Magazine; use base 'Book'; # package and base class
use Simo;
It is like other language class Definition and I think looking is not bat.
and you are not likely to choose wrong order.
=cut | ||||||
| 638 | |||||||
| 639 - 647 | =head1 CAUTION
set_hook and get_hook option is now not recomended. these option will be deleted in future 2019/01/01
and non named defalut value definition is not recommended. this expression cannot be available in future 2019/01/01
sub title{ ac 'OO tutorial' } # not recommend. cannot be available in future.
=cut | ||||||
| 648 | |||||||
| 649 - 701 | =head1 AUTHOR
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-simo at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Simo>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Simo
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Simo>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Simo>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Simo>
=item * Search CPAN
L<http://search.cpan.org/dist/Simo/>
=back
=head1 SEE ALSO
L<Class::Accessor>,L<Class::Accessor::Fast>, L<Moose>, L<Mouse>.
=head1 COPYRIGHT & LICENSE
Copyright 2008 Yuki Kimoto, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut | ||||||
| 702 | |||||||
| 703 | 1; # End of Simo | ||||||