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 $self->locale->text("Database update error:") . "<br>$msg<br>" . $DBI::errstr;
44 my ($self, $query, $may_fail) = @_;
46 return if $self->dbh->do($query);
48 $self->db_error($query) unless $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, $may_fail>
209 Executes an SQL query. What the method does if the query fails depends
210 on C<$may_fail>. If it is falsish then the method will simply die
211 outputting the error message via L</db_error>. If C<$may_fail> is
212 trueish then the current transaction will be rolled back, a new one
215 =item C<execute_script>
217 Executes a named database upgrade script. This function is not
218 supposed to be called from an upgrade script. Instead, the upgrade
219 manager L<SL::DBUpgrade2> uses it in order to execute the actual
220 database upgrade scripts.
222 =item C<is_coa_empty>
224 Returns trueish if no transactions have been recorded in the table
229 This method is the entry point for the actual upgrade. Each upgrade
230 script must provide this method.
240 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>