Swiss QR-Bill: Datenbankupgrade BankAccount
[kivitendo-erp.git] / SL / Clipboard / Base.pm
1 package SL::Clipboard::Base;
2
3 use strict;
4
5 use parent qw(Rose::Object);
6
7 use Rose::Object::MakeMethods::Generic (
8   'scalar --get_set_init' => [ qw(content timestamp) ],
9 );
10
11 use Rose::DB::Object::Helpers ();
12
13 sub init_timestamp { die "'timestamp' property not set"; }
14 sub init_content   { die "'content' property not set";   }
15
16 sub type {
17   my ($self_or_class) = @_;
18   return (split m/::/, ref($self_or_class) ? ref($self_or_class) : $self_or_class)[-1];
19 }
20
21 sub reload_object {
22   my ($self, $object) = @_;
23
24   return ref($object)->new(map { $_ => $object->$_ } $object->meta->primary_key)->load;
25 }
26
27 sub as_tree {
28   my ($self, $object, %params) = @_;
29
30   my $tree = Rose::DB::Object::Helpers::as_tree($object, %params);
31   $self->_fix_tree($tree, $object);
32   return $tree;
33 }
34
35 sub to_object {
36   my ($self) = @_;
37   my $object = Rose::DB::Object::Helpers::new_from_tree("SL::DB::" . $self->type, $self->content);
38
39   # Reset primary key columns and itime/mtime if the class supports it.
40   foreach ($object->meta->primary_key, 'itime', 'mtime') {
41     $object->$_(undef) if $object->can($_);
42   }
43
44   # Let sub classes fix the objects further.
45   $self->_fix_object($object);
46   return $object;
47 }
48
49 sub dump {
50   my ($self, $object) = @_;
51   return $self->as_tree($self->reload_object($object), max_depth => 1);
52 }
53
54 sub describe {
55   die "'describe' method not overwritten by derived class";
56 }
57
58 sub _fix_object {
59   my ($self, $object) = @_;
60   # To be overwritten by child classes.
61 }
62
63 sub _fix_tree {
64   my ($self, $tree, $object) = @_;
65
66   # Delete primary key columns and itime/mtime if the class supports it.
67   foreach ($object->meta->primary_key, 'itime', 'mtime') {
68     delete $tree->{$_} if $object->can($_);
69   }
70 }
71
72 sub _binary_column_names {
73   my ($self, $class) = @_;
74   return map  { $_->name }
75          grep { ref($_) =~ m/Pg::Bytea$/i }
76          @{ $class->meta->columns };
77 }
78
79 1;
80 __END__
81
82 =pod
83
84 =encoding utf8
85
86 =head1 NAME
87
88 SL::Clipboard::Base - Base class for clipboard specialization classes
89
90 =head1 SYNOPSIS
91
92 See the synopsis of L<SL::Clipboard>.
93
94 =head1 OVERVIEW
95
96 This is a base class providing a lot of utility and
97 defaults. Sub-classes must overwrite at least the function
98 L</describe> but can overwrite others as well.
99
100 Writing a specialized sub-class for a database type involves
101 overwriting one or more functions. These are:
102
103 =over 4
104
105 =item * C<describe>
106
107 Must be overwritten. Returns a human-readable description of the
108 content. Should only be one line.
109
110 =item * C<dump>
111
112 Optional. Overwrite if sub-class needs to dump more/less than the
113 implementation in this class dumps.
114
115 =item * C<_fix_object>
116
117 Optional. Overwrite if re-created Rose::DB::Object instances must be
118 cleaned further before they're returned to the caller.
119
120 =item * C<_fix_tree>
121
122 Optional. Overwrite if the tree created during a copy operation of a
123 Rose::DB::Object instance must be cleaned further before it's stored.
124
125 =back
126
127 You don't have to or should not overwrite the other functions:
128
129 =over 4
130
131 =item * C<as_tree>
132
133 =item * C<reload_object>
134
135 =item * C<to_object>
136
137 =item * C<type>
138
139 =back
140
141 Don't forget to C<use> the specialized module here in Base!
142
143 =head1 FUNCTIONS
144
145 =over 4
146
147 =item C<as_tree $object, %params>
148
149 A convenience function calling L<Rose::DB::Object::Helpers/as_tree>
150 with C<$object> and C<%params> as parameters. Returns a hash/array
151 reference tree of the function.
152
153 Don't overwrite this function in sub-classes. Overwrite L</dump>
154 instead.
155
156 =item C<describe>
157
158 Returns a human-readable description of the content. This should only
159 be a single line without any markup.
160
161 Sub-classes must overwrite this function.
162
163 =item C<dump $object>
164
165 Dumps the object as a hash/array tree and returns it by calling
166 L<Rose::DB::Object::Helpers/as_tree>. The default implementation
167 reloads the object first by calling L</reload_object>. It also only
168 dumps the object itself, not any of the relationships, by calling
169 C<as_tree> with the parameter C<max_depth =E<gt> 1>.
170
171 Overwrite this in a sub-class if you need to dump more or differently
172 (see L<SL::Clipboard::RequirementSpecItem> for an example).
173
174 =item C<reload_object $object>
175
176 Reloads C<$object> from the database and returns a new instance. Can
177 be useful for sanitizing the object given to L</dump> before
178 converting into a tree. It is used by the default implementation of
179 L</dump>.
180
181 =item C<to_object>
182
183 Converts the dumped representation back to a Rose::DB::Object
184 instance. Several columns of the newly created object are cleared by
185 C<to_object> itself: the primary key columns (if any) and the columns
186 C<itime> and C<mtime> (if the object has such columns).
187
188 This function should not be overwritten by sub-classes. Instead,
189 functions can overwrite C<_fix_object> which can be used for sanitizing
190 the newly created object before handing it back to the caller.
191
192 =item C<type>
193
194 Returns the actual clipped type (e.g. C<RequirementSpecItem>). This is
195 derived from the actual class name of C<$self>.
196
197 =item C<_binary_column_names $class>
198
199 Returns an array of column names that have a binary type. Useful for
200 sub-classes which need to encode binary content in Base64 during
201 C<dump>.
202
203 =item C<_fix_object $object>
204
205 This function is called by L</to_object> before the object is passed
206 back to the caller. It does not do anything in the default
207 implementation, but sub-classes are free to overwrite it if they need
208 to sanitize the object. See L<SL::Clipboard::RequirementSpecItem> for
209 an example.
210
211 Its return value is ignored.
212
213 =item C<_fix_tree $tree, $object>
214
215 This function is called by L</as_tree> after dumping and before the
216 object is stored during a copy operation. In the default
217 implementation all primary key columns and the columns C<itime> and
218 C<mtime> (if the object has such columns) are removed from the tree.
219 Sub-classes are free to overwrite it if they need to sanitize the
220 tree. See L<SL::Clipboard::RequirementSpecItem> for an example.
221
222 C<$object> is just passed in for reference and should not be modified.
223
224 Its return value is ignored.
225
226 =back
227
228 =head1 BUGS
229
230 Nothing here yet.
231
232 =head1 AUTHOR
233
234 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
235
236 =cut