1 package SL::DBUpgrade2::Base;
5 use parent qw(Rose::Object);
8 use English qw(-no_match_vars);
12 use List::MoreUtils qw(uniq);
14 use Rose::Object::MakeMethods::Generic (
15 scalar => [ qw(dbh myconfig) ],
23 my $file_name = delete $params{file_name};
25 if (!eval { require $file_name }) {
26 delete $INC{$file_name};
30 my $package = delete $params{tag};
31 $package =~ s/[^a-zA-Z0-9_]+/_/g;
32 $package = "SL::DBUpgrade2::${package}";
34 $package->new(%params)->run;
38 my ($self, $msg) = @_;
40 die $::locale->text("Database update error:") . "<br>$msg<br>" . $DBI::errstr;
44 my ($self, $query, %params) = @_;
46 return if $self->dbh->do($query, undef, @{ $params{bind} || [] });
48 $self->db_error($query) unless $params{may_fail};
51 $self->dbh->begin_work;
55 my ($self, $wanted_coa) = @_;
57 my ($have_coa) = selectrow_query($::form, $self->dbh, q{ SELECT count(*) FROM defaults WHERE coa = ? }, $wanted_coa);
65 my $query = q{ SELECT count(*)
66 FROM ar, ap, gl, invoice, acc_trans, customer, vendor, parts
68 my ($empty) = selectrow_query($::form, $self->dbh, $query);
73 sub add_print_templates {
74 my ($self, $src_dir, @files) = @_;
76 $::lxdebug->message(LXDebug::DEBUG1(), "add_print_templates: src_dir $src_dir files " . join(' ', @files));
79 croak "File '${src_dir}/$_' does not exist" unless -f "${src_dir}/$_";
82 my %users = $::auth->read_all_users;
83 my @template_dirs = uniq map { $_ = $_->{templates}; s:/+$::; $_ } values %users;
85 $::lxdebug->message(LXDebug::DEBUG1(), "add_print_templates: template_dirs " . join(' ', @template_dirs));
87 foreach my $src_file (@files) {
88 foreach my $template_dir (@template_dirs) {
89 my $dest_file = $template_dir . '/' . $src_file;
92 $::lxdebug->message(LXDebug::DEBUG1(), "add_print_templates: dest_file exists, skipping: ${dest_file}");
96 my $dest_dir = File::Basename::dirname($dest_file);
98 if ($dest_dir && !-d $dest_dir) {
99 File::Path::make_path($dest_dir) or die "Cannot create directory '${dest_dir}': $!";
102 File::Copy::copy($src_dir . '/' . $src_file, $dest_file) or die "Cannot copy '${src_dir}/${src_file}' to '${dest_file}': $!";
104 $::lxdebug->message(LXDebug::DEBUG1(), "add_print_templates: copied '${src_dir}/${src_file}' to '${dest_file}'");
120 SL::DBUpgrade2::Base - Base class for Perl-based database upgrade files
124 Database scripts written in Perl must be derived from this class and
125 provide a method called C<run>.
127 The functions in this base class offer functionality for the upgrade
132 The following properties (which can be accessed with
133 C<$self-E<gt>property_name>) are available to the database upgrade
140 The database handle; an Instance of L<DBI>. It is connected, and a
141 transaction has been started right before the script (the method
142 L</run>)) was executed.
146 The stripped-down version of the C<%::myconfig> hash: this hash
147 reference only contains the database connection parameters applying to
148 the current database.
156 =item C<add_print_templates $source_dir, @files>
158 Adds (copies) new print templates to existing users. All existing
159 users in the authentication database are read. The listed C<@files>
160 are copied to each user's configured templates directory preserving
161 sub-directory structure (non-existing sub-directories will be
162 created). If a template with the same name exists it will be skipped.
164 The source file names must all be relative to the source directory
165 C<$source_dir>. This way only the desired sub-directories are created
166 in the users' template directories. Example:
168 $self->add_print_templates(
169 'templates/print/Standard',
170 qw(receipt.tex common.sty images/background.png)
173 Let's assume a user's template directory is
174 C<templates/big-money-inc>. The call above would trigger five actions:
178 =item 1. Create the directory C<templates/big-money-inc> if it doesn't
181 =item 2. Copy C<templates/print/Standard/receipt.tex> to
182 C<templates/big-money-inc/receipt.tex> if there's no such file in that
185 =item 3. Copy C<templates/print/Standard/common.sty> to
186 C<templates/big-money-inc/common.sty> if there's no such file in that
189 =item 4. Create the directory C<templates/big-money-inc/images> if it
192 =item 5. Copy C<templates/print/Standard/images/background.png> to
193 C<templates/big-money-inc/images/background.png> if there's no such
194 file in that directory.
198 =item C<check_coa $coa_name>
200 Returns trueish if the database uses the chart of accounts named
203 =item C<db_error $message>
205 Outputs an error message C<$message> to the user and aborts execution.
207 =item C<db_query $query, %params>
209 Executes an SQL query. The following parameters are supported:
215 What the method does if the query fails depends on this parameter. If
216 it is falsish (the default) then the method will simply die outputting
217 the error message via L</db_error>. If C<may_fail> is trueish then the
218 current transaction will be rolled back, a new one will be started.
222 An optional array reference containing bind parameter for the query.
226 =item C<execute_script>
228 Executes a named database upgrade script. This function is not
229 supposed to be called from an upgrade script. Instead, the upgrade
230 manager L<SL::DBUpgrade2> uses it in order to execute the actual
231 database upgrade scripts.
233 =item C<is_coa_empty>
235 Returns trueish if no transactions have been recorded in the table
240 This method is the entry point for the actual upgrade. Each upgrade
241 script must provide this method.
251 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>