1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
# Copyright (C) 2008-2010, Sebastian Riedel.
package Mojo::Base;
use strict;
use warnings;
# No imports because we get subclassed, a lot!
require Carp;
# Kids, you tried your best and you failed miserably.
# The lesson is, never try.
sub new {
my $class = shift;
# Instantiate
return bless
exists $_[0] ? exists $_[1] ? {@_} : {%{$_[0]}} : {},
ref $class || $class;
}
# Performance is very important for something as often used as accessors,
# so we optimize them by compiling our own code, don't be scared, we have
# tests for every single case
sub attr {
my $class = shift;
my $attrs = shift;
my $default = shift;
# Check for more arguments
Carp::croak('Attribute generator called with too many arguments') if @_;
# Shortcut
return unless $class && $attrs;
# Check default
Carp::croak('Default has to be a code reference or constant value')
if ref $default && ref $default ne 'CODE';
# Allow symbolic references
no strict 'refs';
# Create attributes
$attrs = ref $attrs eq 'ARRAY' ? $attrs : [$attrs];
my $ws = ' ';
for my $attr (@$attrs) {
Carp::croak(qq/Attribute "$attr" invalid/)
unless $attr =~ /^[a-zA-Z_]\w*$/;
# Header
my $code = "sub {\n";
# No value
$code .= "${ws}if (\@_ == 1) {\n";
unless (defined $default) {
# Return value
$code .= "$ws${ws}return \$_[0]->{'$attr'};\n";
}
else {
# Return value
$code .= "$ws${ws}return \$_[0]->{'$attr'} ";
$code .= "if exists \$_[0]->{'$attr'};\n";
# Return default value
$code .= "$ws${ws}return \$_[0]->{'$attr'} = ";
$code .=
ref $default eq 'CODE'
? '$default->($_[0])'
: '$default';
$code .= ";\n";
}
$code .= "$ws}\n";
# Store value
$code .= "$ws\$_[0]->{'$attr'} = \$_[1];\n";
# Return invocant
$code .= "${ws}return \$_[0];\n";
# Footer
$code .= '};';
# We compile custom attribute code for speed
*{"${class}::$attr"} = eval $code;
# This should never happen (hopefully)
Carp::croak("Mojo::Base compiler error: \n$code\n$@\n") if $@;
# Debug mode
if ($ENV{MOJO_BASE_DEBUG}) {
warn "\nATTRIBUTE: $class->$attr\n";
warn "$code\n\n";
}
}
}
1;
__END__
=head1 NAME
Mojo::Base - Minimal Base Class For Mojo Projects
=head1 SYNOPSIS
package Car;
use base 'Mojo::Base';
__PACKAGE__->attr('driver');
__PACKAGE__->attr('doors' => 2);
__PACKAGE__->attr([qw/passengers seats/] => sub { 2 });
package main;
my $bmw = Car->new;
print $bmw->doors;
print $bmw->doors(5)->doors;
my $mercedes = Car->new(driver => 'Sebastian');
print $mercedes->passengers(7)->passengers;
=head1 DESCRIPTION
L<Mojo::Base> is a simple base class for L<Mojo> projects.
=head1 METHODS
=head2 C<new>
my $instance = BaseSubClass->new;
my $instance = BaseSubClass->new(name => 'value');
my $instance = BaseSubClass->new({name => 'value'});
This base class provides a basic object constructor.
You can pass it either a hash or a hash reference with attribute values.
=head2 C<attr>
__PACKAGE__->attr('name');
__PACKAGE__->attr([qw/name1 name2 name3/]);
__PACKAGE__->attr(name => 'foo');
__PACKAGE__->attr(name => sub { ... });
__PACKAGE__->attr([qw/name1 name2 name3/] => 'foo');
__PACKAGE__->attr([qw/name1 name2 name3/] => sub { ... });
Create attributes.
An arrayref can be used to create more than one attribute.
Pass an optional second argument to set a default value, it should be a
constant or a sub reference.
The sub reference will be excuted at accessor read time if there's no set
value.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
=cut
|
