File: Base.pm

package info (click to toggle)
maypole 2.10-1
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 472 kB
  • ctags: 108
  • sloc: perl: 1,345; makefile: 21
file content (205 lines) | stat: -rw-r--r-- 4,678 bytes parent folder | download
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
package Maypole::Model::Base;

use strict;
use Maypole::Constants;
use attributes ();

our %remember;

sub MODIFY_CODE_ATTRIBUTES { $remember{ $_[1] } = $_[2]; () }

sub FETCH_CODE_ATTRIBUTES { $remember{ $_[1] } || () }

sub process {
    my ( $class, $r ) = @_;
    my $method = $r->action;
    return if $r->{template};    # Authentication has set this, we're done.

    $r->{template} = $method;
    my $obj = $class->fetch_objects($r);
    $r->objects([$obj]) if $obj;
    $class->$method( $r, $obj, @{ $r->{args} } );
}

sub list_columns {
    shift->display_columns;
}

sub display_columns {
    sort shift->columns;
}

=head1 NAME

Maypole::Model::Base - Base class for model classes

=head1 DESCRIPTION

This is the base class for Maypole data models. This is an abstract class
that defines the interface, and can't be used directly.

=head2 process

This is the engine of this module. Given the request object, it populates
all the relevant variables and calls the requested action.

Anyone subclassing this for a different database abstraction mechanism
needs to provide the following methods:

=head2 setup_database

    $model->setup_database($config, $namespace, @data)

Uses the user-defined data in C<@data> to specify a database- for
example, by passing in a DSN. The model class should open the database,
and create a class for each table in the database. These classes will
then be C<adopt>ed. It should also populate C<< $config->tables >> and
C<< $config->classes >> with the names of the classes and tables
respectively. The classes should be placed under the specified
namespace. For instance, C<beer> should be mapped to the class
C<BeerDB::Beer>.

=head2 class_of

    $model->class_of($r, $table)

This maps between a table name and its associated class.

=head2 fetch_objects

This class method is passed a request object and is expected to return an
object of the appropriate table class from information stored in the request
object.

=head2 adopt

This class method is passed the name of a model class that represensts a table
and allows the master model class to do any set-up required.

=head2 columns

This is a list of all the columns in a table. You may also override
see also C<display_columns>

=head2 table

This is the name of the table.

=cut 

sub class_of       { die "This is an abstract method" }
sub setup_database { die "This is an abstract method" }
sub fetch_objects { die "This is an abstract method" }

=head2 Actions

=over

=item do_edit

If there is an object in C<$r-E<gt>objects>, then it should be edited
with the parameters in C<$r-E<gt>params>; otherwise, a new object should
be created with those parameters, and put back into C<$r-E<gt>objects>.
The template should be changed to C<view>, or C<edit> if there were any
errors. A hash of errors will be passed to the template.

=cut

sub do_edit { die "This is an abstract method" }

=item list

The C<list> method should fill C<$r-E<gt>objects> with all of the
objects in the class. You may want to page this using C<Data::Page> or
similar.

=item edit

Empty Action.

=item view

Empty Action.


=back

=cut

sub list : Exported {
    die "This is an abstract method";
}

sub view : Exported {
}

sub edit : Exported {
}

=pod

Also, see the exported commands in C<Maypole::Model::CDBI>.

=head1 Other overrides

Additionally, individual derived model classes may want to override the
following methods:

=head2 display_columns

Returns a list of columns to display in the model. By default returns
all columns in alphabetical order. Override this in base classes to
change ordering, or elect not to show columns.

=head2 list_columns

Same as display_columns, only for listings. Defaults to display_columns

=head2 column_names

Return a hash mapping column names with human-readable equivalents.

=cut

sub column_names {
    my $class = shift;
    map {
        my $col = $_;
        $col =~ s/_+(\w)?/ \U$1/g;
        $_ => ucfirst $col
    } $class->columns;
}

=head2 is_public

should return true if a certain action is supported, or false otherwise. 
Defaults to checking if the sub has the C<:Exported> attribute.

=cut

sub is_public {
    my ( $self, $action ) = @_;
    my $cv = $self->can($action);
    return 0 unless $cv;
    my $attrs = join " ", (attributes::get($cv) || ());
    do {
        warn "$action not exported" if Maypole->debug;
        return 0;
    } unless $attrs =~ /\bExported\b/i;
    return 1;
}

=head2 related

This can go either in the master model class or in the individual
classes, and returns a list of has-many accessors. A brewery has many
beers, so C<BeerDB::Brewery> needs to return C<beers>.

=cut

sub related {
}

1;