Revision 347f2cff
Von Moritz Bunkus vor mehr als 11 Jahren hinzugefügt
| sql/Pg-upgrade2/erzeugnisnummern.pl | ||
|---|---|---|
| 1 | 1 |
# @tag: erzeugnisnummern |
| 2 | 2 |
# @description: Erzeugnisnummern und Artikelnummern sollen eindeutig sein. |
| 3 | 3 |
# @depends: release_3_0_0 |
| 4 |
# @charset: utf-8
|
|
| 4 |
package SL::DBUpgrade2::erzeugnisnummern;
|
|
| 5 | 5 |
|
| 6 |
use utf8; |
|
| 7 | 6 |
use strict; |
| 8 |
use SL::Locale; |
|
| 9 |
|
|
| 10 |
die("This script cannot be run from the command line.") unless ($main::form);
|
|
| 11 |
|
|
| 12 |
sub mydberror {
|
|
| 13 |
my ($msg) = @_; |
|
| 14 |
die($dbup_locale->text("Database update error:") . "<br>$msg<br>" . $DBI::errstr);
|
|
| 15 |
} |
|
| 7 |
use utf8; |
|
| 16 | 8 |
|
| 17 |
sub do_query {
|
|
| 18 |
my ($query, $may_fail) = @_; |
|
| 9 |
use parent qw(SL::DBUpgrade2::Base); |
|
| 19 | 10 |
|
| 20 |
if (!$dbh->do($query)) {
|
|
| 21 |
mydberror($query) unless ($may_fail); |
|
| 22 |
$dbh->rollback(); |
|
| 23 |
$dbh->begin_work(); |
|
| 24 |
} |
|
| 25 |
} |
|
| 11 |
sub run {
|
|
| 12 |
my ($self) = @_; |
|
| 26 | 13 |
|
| 27 |
sub do_update {
|
|
| 28 |
if ( $main::form->{'continued'} ) {
|
|
| 14 |
if ( $::form->{'continued'} ) {
|
|
| 29 | 15 |
my $update_query; |
| 30 |
foreach my $i (1 .. $main::form->{rowcount}) {
|
|
| 31 |
$update_query = qq|UPDATE parts SET partnumber = '| . $main::form->{"partnumber_$i"} . qq|' WHERE id = | . $main::form->{"partid_$i"};
|
|
| 32 |
do_query($update_query);
|
|
| 16 |
foreach my $i (1 .. $::form->{rowcount}) {
|
|
| 17 |
$update_query = qq|UPDATE parts SET partnumber = '| . $::form->{"partnumber_$i"} . qq|' WHERE id = | . $::form->{"partid_$i"};
|
|
| 18 |
$self->db_query($update_query);
|
|
| 33 | 19 |
print FH $i; |
| 34 | 20 |
} |
| 35 |
$dbh->commit(); |
|
| 21 |
$self->dbh->commit();
|
|
| 36 | 22 |
} |
| 37 | 23 |
|
| 38 | 24 |
my $query = qq|SELECT id, partnumber, description, unit, notes, assembly, ean, inventory_accno_id |
| ... | ... | |
| 43 | 29 |
> 1 |
| 44 | 30 |
ORDER BY partnumber;|; |
| 45 | 31 |
|
| 46 |
my $sth = $dbh->prepare($query); |
|
| 47 |
$sth->execute || $main::form->dberror($query);
|
|
| 32 |
my $sth = $self->dbh->prepare($query);
|
|
| 33 |
$sth->execute || $::form->dberror($query); |
|
| 48 | 34 |
|
| 49 |
$main::form->{PARTS} = [];
|
|
| 35 |
$::form->{PARTS} = [];
|
|
| 50 | 36 |
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
| 51 | 37 |
map {$ref->{$_} = $::locale->{iconv_utf8}->convert($ref->{$_})} keys %$ref;
|
| 52 |
push @{ $main::form->{PARTS} }, $ref;
|
|
| 38 |
push @{ $::form->{PARTS} }, $ref;
|
|
| 53 | 39 |
} |
| 54 | 40 |
|
| 55 |
if ( scalar @{ $main::form->{PARTS} } > 0 ) {
|
|
| 41 |
if ( scalar @{ $::form->{PARTS} } > 0 ) {
|
|
| 56 | 42 |
&print_error_message; |
| 57 | 43 |
return 2; |
| 58 | 44 |
} |
| 59 | 45 |
|
| 60 | 46 |
$query = qq|ALTER TABLE parts ADD UNIQUE (partnumber)|; |
| 61 |
do_query($query);
|
|
| 47 |
$self->db_query($query);
|
|
| 62 | 48 |
|
| 63 | 49 |
$query = qq|ALTER TABLE defaults ADD assemblynumber TEXT|; |
| 64 |
do_query($query);
|
|
| 50 |
$self->db_query($query);
|
|
| 65 | 51 |
return 1; |
| 66 |
}; # end do_update |
|
| 67 |
|
|
| 52 |
} # end run |
|
| 68 | 53 |
|
| 69 | 54 |
sub print_error_message {
|
| 70 |
print $main::form->parse_html_template("dbupgrade/erzeugnisnummern");
|
|
| 55 |
print $::form->parse_html_template("dbupgrade/erzeugnisnummern");
|
|
| 71 | 56 |
} |
| 72 | 57 |
|
| 73 |
return do_update(); |
|
| 58 |
1; |
|
Auch abrufbar als: Unified diff
Perl-Datenbank-Upgradescripte auf Objektorientierung & strict umgestellt