kivitendo/SL/DBUpgrade2/Base.pm @ b3219da5
| 347f2cff | Moritz Bunkus | package SL::DBUpgrade2::Base;
|
|
use strict;
|
|||
use parent qw(Rose::Object);
|
|||
use English qw(-no_match_vars);
|
|||
use Rose::Object::MakeMethods::Generic (
|
|||
scalar => [ qw(dbh myconfig) ],
|
|||
);
|
|||
use SL::DBUtils;
|
|||
sub execute_script {
|
|||
my (%params) = @_;
|
|||
my $file_name = delete $params{file_name};
|
|||
if (!eval { require $file_name }) {
|
|||
delete $INC{$file_name};
|
|||
die $EVAL_ERROR;
|
|||
}
|
|||
my $package = delete $params{tag};
|
|||
$package =~ s/[^a-zA-Z0-9_]+/_/g;
|
|||
$package = "SL::DBUpgrade2::${package}";
|
|||
$package->new(%params)->run;
|
|||
}
|
|||
sub db_error {
|
|||
my ($self, $msg) = @_;
|
|||
die $self->locale->text("Database update error:") . "<br>$msg<br>" . $DBI::errstr;
|
|||
}
|
|||
sub db_query {
|
|||
my ($self, $query, $may_fail) = @_;
|
|||
return if $self->dbh->do($query);
|
|||
$self->db_error($query) unless $may_fail;
|
|||
$self->dbh->rollback;
|
|||
$self->dbh->begin_work;
|
|||
}
|
|||
sub check_coa {
|
|||
my ($self, $wanted_coa) = @_;
|
|||
my ($have_coa) = selectrow_query($::form, $self->dbh, q{ SELECT count(*) FROM defaults WHERE coa = ? }, $wanted_coa);
|
|||
return $have_coa;
|
|||
}
|
|||
sub is_coa_empty {
|
|||
my ($self) = @_;
|
|||
my $query = q{ SELECT count(*)
|
|||
FROM ar, ap, gl, invoice, acc_trans, customer, vendor, parts
|
|||
};
|
|||
my ($empty) = selectrow_query($::form, $self->dbh, $query);
|
|||
return !$empty;
|
|||
}
|
|||
1;
|
|||
__END__
|
|||
=pod
|
|||
=encoding utf8
|
|||
=head1 NAME
|
|||
SL::DBUpgrade2::Base - Base class for Perl-based database upgrade files
|
|||
=head1 OVERVIEW
|
|||
Database scripts written in Perl must be derived from this class and
|
|||
provide a method called C<run>.
|
|||
The functions in this base class offer functionality for the upgrade
|
|||
scripts.
|
|||
=head1 PROPERTIES
|
|||
The following properties (which can be accessed with
|
|||
C<$self-E<gt>property_name>) are available to the database upgrade
|
|||
script:
|
|||
=over 4
|
|||
=item C<dbh>
|
|||
The database handle; an Instance of L<DBI>. It is connected, and a
|
|||
transaction has been started right before the script (the method
|
|||
L</run>)) was executed.
|
|||
=item C<myconfig>
|
|||
The stripped-down version of the C<%::myconfig> hash: this hash
|
|||
reference only contains the database connection parameters applying to
|
|||
the current database.
|
|||
=back
|
|||
=head1 FUNCTIONS
|
|||
=over 4
|
|||
=item C<check_coa $coa_name>
|
|||
Returns trueish if the database uses the chart of accounts named
|
|||
C<$coa_name>.
|
|||
=item C<db_error $message>
|
|||
Outputs an error message C<$message> to the user and aborts execution.
|
|||
=item C<db_query $query, $may_fail>
|
|||
Executes an SQL query. What the method does if the query fails depends
|
|||
on C<$may_fail>. If it is falsish then the method will simply die
|
|||
outputting the error message via L</db_error>. If C<$may_fail> is
|
|||
trueish then the current transaction will be rolled back, a new one
|
|||
will be started
|
|||
=item C<execute_script>
|
|||
Executes a named database upgrade script. This function is not
|
|||
supposed to be called from an upgrade script. Instead, the upgrade
|
|||
manager L<SL::DBUpgrade2> uses it in order to execute the actual
|
|||
database upgrade scripts.
|
|||
=item C<is_coa_empty>
|
|||
Returns trueish if no transactions have been recorded in the table
|
|||
C<acc_trans> yet.
|
|||
=item C<run>
|
|||
This method is the entry point for the actual upgrade. Each upgrade
|
|||
script must provide this method.
|
|||
=back
|
|||
=head1 BUGS
|
|||
Nothing here yet.
|
|||
=head1 AUTHOR
|
|||
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
|||
=cut
|