File Coverage

blib/lib/Class/DBI/Relationship.pm

Criterion	Covered	Total	%
statement	36	39	92.3
branch	3	4	75.0
condition			n/a
subroutine	10	12	83.3
pod	3	4	75.0
total	52	59	88.1

line	stmt	bran	sub	pod	time	code
1						package Class::DBI::Relationship;
2
3	24		24		328	use strict;
	24				227
	24				340
4	24		24		489	use warnings;
	24				221
	24				326
5
6	24		24		832	use base 'Class::Accessor::Fast';
	24				253
	24				576
7
8						__PACKAGE__->mk_accessors(qw/name class accessor foreign_class args/);
9
10						sub set_up {
11	33		33	0	345	my $proto = shift;
12	33				505	my $self = $proto->_init(@_);
13	30				1862	$self->_set_up_class_data;
14	30				628	$self->_add_triggers;
15	30				2305	$self->_add_methods;
16	30				371	$self;
17						}
18
19						sub _init {
20	33		33		304	my $proto = shift;
21	33				357	my $name = shift;
22	33				477	my ($class, $accessor, $foreign_class, $args) = $proto->remap_arguments(@_);
23	30				862	$class->clear_object_index;
24	30				1126	return $proto->new(
25						{
26						name => $name,
27						class => $class,
28						foreign_class => $foreign_class,
29						accessor => $accessor,
30						args => $args,
31						}
32						);
33						}
34
35						sub remap_arguments {
36	0		0	1	0	my $self = shift;
37	0				0	return @_;
38						}
39
40						sub _set_up_class_data {
41	30		30		308	my $self = shift;
42	30				424	$self->class->_extend_meta($self->name => $self->accessor => $self);
43						}
44
45	0		0	1	0	sub triggers { () }
46
47						sub _add_triggers {
48	30		30		335	my $self = shift;
49
50						# need to treat as list in case there are multiples for the same point.
51	30	50			561	my @triggers = $self->triggers or return;
52	30				2617	while (my ($point, $subref) = (splice @triggers, 0, 2)) {
53	85				5135	$self->class->add_trigger($point => $subref);
54						}
55						}
56
57	18		18	1	234	sub methods { () }
58
59						sub _add_methods {
60	30		30		295	my $self = shift;
61	30	100			505	my %methods = $self->methods or return;
62	12				152	my $class = $self->class;
63	24		24		611	no strict 'refs';
	24				254
	24				392
64	12				258	foreach my $method (keys %methods) {
65	24				232	*{"$class\::$method"} = $methods{$method};
	24				399
66						}
67						}
68
69						1;
70
71						__END__
72
73						=head1 NAME
74
75						Class::DBI::Relationship - base class for Relationships
76
77						=head1 DESCRIPTION
78
79						A Class::DBI class represents a database table. But merely being able
80						to represent single tables isn't really that useful - databases are all
81						about relationships.
82
83						So, Class::DBI provides a variety of Relationship models to represent
84						common database occurences (HasA, HasMany and MightHave), and provides
85						a way to add others.
86
87						=head1 SUBCLASSING
88
89						Relationships should inherit from Class::DBI::Relationship, and
90						provide a variety of methods to represent the relationship. For
91						examples of how these are used see Class::DBI::Relationship::HasA,
92						Class::DBI::Relationship::HasMany and Class::DBI::Relationship::MightHave.
93
94						=head2 remap_arguments
95
96						sub remap_arguments {
97						my $self = shift;
98						# process @_;
99						return ($class, accessor, $foreign_class, $args)
100						}
101
102						Subclasses should define a 'remap_arguments' method that takes the
103						arguments with which your relationship method will be called, and
104						transforms them into the structure that the Relationship modules requires.
105						If this method is not provided, then it is assumed that your method will
106						be called with these 3 arguments in this order.
107
108						This should return a list of 4 items:
109
110						=over 4
111
112						=item class
113
114						The Class::DBI subclass to which this relationship applies. This will be
115						passed in to you from the caller who actually set up the relationship,
116						and is available for you to call methods on whilst performing this
117						mapping. You should almost never need to change this.
118
119						This usually an entire application base class (or Class::DBI itself),
120						but could be a single class wishing to override a default relationship.
121
122						=item accessor
123
124						The method in the class which will provide access to the results of
125						the relationship.
126
127						=item foreign_class
128
129						The class for the table with which the class has a relationship.
130
131						=item args
132
133						Any additional args that your relationship requires. It is recommended
134						that you use this as a hashref to store any extra information your
135						relationship needs rather than adding extra accessors, as this information
136						will all be stored in the 'meta_info'.
137
138						=back
139
140						=head2 triggers
141
142						sub triggers {
143						return (
144						before_create => sub { ... },
145						after_create => sub { ... },
146						);
147						}
148
149						Subclasses may define a 'triggers' method that returns a list of
150						triggers that the relationship needs. This method can be omitted if
151						there are no triggers to be set up.
152
153						=head2 methods
154
155						sub methods {
156						return (
157						method1 => sub { ... },
158						method2 => sub { ... },
159						);
160						}
161
162						Subclasses may define a 'methods' method that returns a list of methods
163						to facilitate the relationship that should be created in the calling
164						Class::DBI class. This method can be omitted if there are no methods
165						to be set up.
166
167						=cut
168