- # ignore comments or empty lines
- next if /^(--.*|\s+)$/;
-
- for (my $i = 0; $i < length($_); $i++) {
- my $char = substr($_, $i, 1);
-
- # Are we inside a string?
- if (@quote_chars) {
- if ($char eq $quote_chars[-1]) {
- pop(@quote_chars);
- }
- $query .= $char;
-
- } else {
- if (($char eq "'") || ($char eq "\"")) {
- push(@quote_chars, $char);
-
- } elsif ($char eq ";") {
-
- # Query is complete. Check for triggers and functions.
- if ($query =~ /^create\s+function\s+\"?(\w+)\"?/i) {
- push(@functions, $query);
-
- } elsif ($query =~ /^create\s+trigger\s+\"?(\w+)\"?/i) {
- push(@triggers, $query);
-
- } elsif ($query =~ /^create\s+sequence\s+\"?(\w+)\"?/i) {
- push(@sequences, $1);
-
- } elsif ($query =~ /^create\s+table\s+\"?(\w+)\"?/i) {
- $tablespecs{$1} = $query;
-
- } elsif ($query =~ /^create\s+index\s+\"?(\w+)\"?/i) {
- push(@indices, $query);
-
- }
-
- $query = "";
- $char = "";
- }
-
- $query .= $char;
- }
- }
- }
- close(FH);
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- # get all the tables
- my @tables = $dbh->tables('', '', 'customer', '', { noprefix => 0 });
-
- my $today = scalar localtime;
-
- $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost};
-
- print OUT qq|-- Lx-Office Backup
--- Dataset: $myconfig->{dbname}
--- Version: $form->{dbversion}
--- Host: $myconfig->{dbhost}
--- Login: $form->{login}
--- User: $myconfig->{name}
--- Date: $today
---
--- set options
-$myconfig->{dboptions};
---
-|;
-
- print OUT "-- DROP Sequences\n";
- my $item;
- foreach $item (@sequences) {
- print OUT qq|DROP SEQUENCE $item;\n|;
- }
-
- print OUT "-- DROP Triggers\n";
-
- foreach $item (@triggers) {
- if ($item =~ /^create\s+trigger\s+\"?(\w+)\"?\s+.*on\s+\"?(\w+)\"?\s+/i) {
- print OUT qq|DROP TRIGGER "$1" ON "$2";\n|;
- }
- }
-
- print OUT "-- DROP Functions\n";
-
- foreach $item (@functions) {
- if ($item =~ /^create\s+function\s+\"?(\w+)\"?/i) {
- print OUT qq|DROP FUNCTION "$1" ();\n|;
- }
- }
-
- foreach $table (@tables) {
- if (!($table =~ /^sql_.*/)) {
- my $query = qq|SELECT * FROM $table|;
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $query = "INSERT INTO $table (";
- map { $query .= qq|$sth->{NAME}->[$_],| }
- (0 .. $sth->{NUM_OF_FIELDS} - 1);
- chop $query;
-
- $query .= ") VALUES";
-
- if ($tablespecs{$table}) {
- print(OUT "--\n");
- print(OUT "DROP TABLE $table;\n");
- print(OUT $tablespecs{$table}, ";\n");
- } else {
- print(OUT "--\n");
- print(OUT "DELETE FROM $table;\n");
- }
- while (my @arr = $sth->fetchrow_array) {
-
- $fields = "(";
- foreach my $item (@arr) {
- if (defined $item) {
- $item =~ s/\'/\'\'/g;
- $fields .= qq|'$item',|;
- } else {
- $fields .= 'NULL,';
- }
- }
-
- chop $fields;
- $fields .= ")";
-
- print OUT qq|$query $fields;\n|;
- }
-
- $sth->finish;
- }
- }
-
- # create indices, sequences, functions and triggers
-
- print(OUT "-- CREATE Indices\n");
- map({ print(OUT "$_;\n"); } @indices);
-
- print OUT "-- CREATE Sequences\n";
- foreach $item (@sequences) {
- $query = qq|SELECT last_value FROM $item|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
- my ($id) = $sth->fetchrow_array;
- $sth->finish;
-
- print OUT qq|--
-CREATE SEQUENCE $item START $id;
-|;
- }
-
- print OUT "-- CREATE Functions\n";
-
- # functions
- map { print(OUT $_, ";\n"); } @functions;
-
- print OUT "-- CREATE Triggers\n";
-
- # triggers
- map { print(OUT $_, ";\n"); } @triggers;
-
- close(OUT);
-
- $dbh->disconnect;
-
- # compress backup
- my @args = ("gzip", "$tmpfile");
- system(@args) == 0 or $form->error("$args[0] : $?");
-
- $tmpfile .= ".gz";
-
- if ($form->{media} eq 'email') {
- @{ $mail->{attachments} } = ($tmpfile);
- $err = $mail->send($out);
- }
-
- if ($form->{media} eq 'file') {
-
- open(IN, "$tmpfile") or $form->error("$tmpfile : $!");
- open(OUT, ">-") or $form->error("STDOUT : $!");
-
- print OUT qq|Content-Type: application/x-tar-gzip;
-Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}.sql.gz"
-
-|;
-
- while (<IN>) {
- print OUT $_;
- }
-
- close(IN);
- close(OUT);
-
- }
-
- unlink "$tmpfile";
-
- $main::lxdebug->leave_sub();
-}
-
-sub closedto {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- my $query = qq|SELECT closedto, revtrans FROM defaults|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
-
- $sth->finish;
-
- $dbh->disconnect;
-
- $main::lxdebug->leave_sub();
-}
-
-sub closebooks {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- if ($form->{revtrans}) {
-
- $query = qq|UPDATE defaults SET closedto = NULL,
- revtrans = '1'|;
- } elsif ($form->{closedto}) {
-
- $query = qq|UPDATE defaults SET closedto = '$form->{closedto}',
- revtrans = '0'|;
- } else {
-
- $query = qq|UPDATE defaults SET closedto = NULL,
- revtrans = '0'|;
- }
-
- # set close in defaults
- $dbh->do($query) || $form->dberror($query);
-
- $dbh->disconnect;
-
- $main::lxdebug->leave_sub();
-}
-
-sub get_base_unit {
- my ($self, $units, $unit_name, $factor) = @_;
-
- $factor = 1 unless ($factor);
-
- my $unit = $units->{$unit_name};
-
- if (!defined($unit) || !$unit->{"base_unit"} ||
- ($unit_name eq $unit->{"base_unit"})) {
- return ($unit_name, $factor);
- }
-
- return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
-}
-
-sub retrieve_units {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $form, $type, $prefix) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- my $query = "SELECT *, base_unit AS original_base_unit FROM units";
- my @values;
- if ($type) {
- $query .= " WHERE (type = ?)";
- @values = ($type);
- }
-
- my $sth = $dbh->prepare($query);
- $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
-
- my $units = {};
- while (my $ref = $sth->fetchrow_hashref()) {
- $units->{$ref->{"name"}} = $ref;
- }
- $sth->finish();
-
- foreach my $unit (keys(%{$units})) {
- ($units->{$unit}->{"${prefix}base_unit"}, $units->{$unit}->{"${prefix}factor"}) = AM->get_base_unit($units, $unit);
- }
-
- $dbh->disconnect();
-
- $main::lxdebug->leave_sub();
-
- return $units;
-}
-
-sub units_in_use {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $form, $units) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- foreach my $unit (values(%{$units})) {
- my $base_unit = $unit->{"original_base_unit"};
- while ($base_unit) {
- $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
- push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
- $base_unit = $units->{$base_unit}->{"original_base_unit"};
- }
- }
-
- foreach my $unit (values(%{$units})) {
- $unit->{"in_use"} = 0;
- map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
-
- foreach my $table (qw(parts invoice orderitems)) {
- my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
-
- if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
- $query .= "= " . $dbh->quote($unit->{"name"});
- } else {
- $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," . join(",", @{$unit->{"DEPENDING_UNITS"}}) . ")";
- }
-
- my ($count) = $dbh->selectrow_array($query);
- $form->dberror($query) if ($dbh->err);
-
- if ($count) {
- $unit->{"in_use"} = 1;
- last;
- }
- }
- }
-
- $dbh->disconnect();
-
- $main::lxdebug->leave_sub();
-}
-
-sub unit_select_data {
- $main::lxdebug->enter_sub();
-
- my ($self, $units, $selected, $empty_entry) = @_;
-
- my $select = [];
-
- if ($empty_entry) {
- push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
- }
-
- foreach my $unit (sort({ lc($a) cmp lc($b) } keys(%{$units}))) {
- push(@{$select}, { "name" => $unit,
- "base_unit" => $units->{$unit}->{"base_unit"},
- "factor" => $units->{$unit}->{"factor"},
- "selected" => ($unit eq $selected) ? "selected" : "" });
- }
-
- $main::lxdebug->leave_sub();
-
- return $select;
-}
-
-sub unit_select_html {
- $main::lxdebug->enter_sub();
-
- my ($self, $units, $name, $selected, $convertible_into) = @_;
-
- my $select = "<select name=${name}>";
-
- foreach my $unit (sort({ lc($a) cmp lc($b) } keys(%{$units}))) {
- if (!$convertible_into ||
- ($units->{$convertible_into} &&
- ($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
- $select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
- }
- }
- $select .= "</select>";
-
- $main::lxdebug->leave_sub();
-
- return $select;
-}
-
-sub add_unit {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $form, $name, $base_unit, $factor, $type) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- my $query = "INSERT INTO units (name, base_unit, factor, type) VALUES (?, ?, ?, ?)";
- $dbh->do($query, undef, $name, $base_unit, $factor, $type) || $form->dberror($query . " ($name, $base_unit, $factor, $type)");
- $dbh->disconnect();
-
- $main::lxdebug->leave_sub();
-}
-
-sub save_units {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $form, $type, $units, $delete_units) = @_;
-
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my ($base_unit, $unit, $sth, $query);
-
- if ($delete_units && (0 != scalar(@{$delete_units}))) {
- $query = "DELETE FROM units WHERE name = ?";
- $sth = $dbh->prepare($query);
- map({ $sth->execute($_) || $form->dberror($query . " ($_)"); } @{$delete_units});
- $sth->finish();
- }
-
- $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
- $sth = $dbh->prepare($query);
-
- foreach $unit (values(%{$units})) {
- $unit->{"depth"} = 0;
- my $base_unit = $unit;
- while ($base_unit->{"base_unit"}) {
- $unit->{"depth"}++;
- $base_unit = $units->{$base_unit->{"base_unit"}};
- }
- }
-
- foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
- next if ($unit->{"unchanged_unit"});
-
- my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
- $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
- }
-
- $sth->finish();
- $dbh->commit();
- $dbh->disconnect();
-
- $main::lxdebug->leave_sub();