use SL::MoreCommon;
use Data::Dumper;
+use strict;
+
sub close_orders_if_billed {
$main::lxdebug->enter_sub();
use SL::User;
use SL::DBUtils;
+use strict;
+
sub new {
$main::lxdebug->enter_sub();
$dsn .= ';port=' . $cfg->{port};
}
- $main::lxdebug->message(LXDebug::DEBUG1, "Auth::dbconnect DSN: $dsn");
+ $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
$self->{dbh} = DBI->connect($dsn, $cfg->{user}, $cfg->{password}, { 'AutoCommit' => 0 });
$dsn .= ';port=' . $cfg->{port};
}
- $main::lxdebug->message(LXDebug::DEBUG1, "Auth::create_database DSN: $dsn");
+ $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
my $dbh = DBI->connect($dsn, $params{superuser}, $params{superuser_password});
my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
- $main::lxdebug->message(LXDebug::DEBUG1, "Auth::create_database query: $query");
+ $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
$dbh->do($query);
use SL::DBUtils;
+use strict;
+
sub get_vc {
$main::lxdebug->enter_sub();
my $vc = $form->{vc} eq "customer" ? "customer" : "vendor";
my $arap_type = defined($arap{$form->{type}}) ? $arap{$form->{type}} : 'ar';
- $query =
+ my $query =
qq|SELECT count(*) | .
qq|FROM (SELECT DISTINCT ON (vc.id) vc.id FROM $vc vc, $arap_type a, status s | .
qq| WHERE a.${vc}_id = vc.id AND s.trans_id = a.id AND s.formname = ? | .
qq|WHERE a.${vc}_id = vc.id AND s.trans_id = a.id AND s.formname = ? | .
qq| AND s.spoolfile IS NOT NULL|;
- $sth = $dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute($form->{type}) || $form->dberror($query . " ($form->{type})");
$form->{"all_${vc}"} = [];
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
push @{ $form->{"all_${vc}"} }, $ref;
}
$sth->finish;
$sth->execute($form->{type}) || $form->dberror($query . " ($form->{type})");
$form->{accounts} = [];
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
push @{ $form->{accounts} }, $ref;
}
}
}
- my @a = (transdate, $invnumber, name);
+ my @a = ("transdate", $invnumber, "name");
my $sortorder = join ', ', $form->sort_columns(@a);
if (grep({ $_ eq $form->{sort} }
$form->dberror($query . " (" . join(", ", @values) . ")");
$form->{SPOOL} = [];
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
push @{ $form->{SPOOL} }, $ref;
}
open(OUT, $output) or $form->error("$output : $!");
$form->{"spoolfile_$i"} =~ s|.*/||;
- $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|;
+ my $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|;
# send file to printer
open(IN, $spoolfile) or $form->error("$spoolfile : $!");
use SL::DBUtils;
-use vars qw(@db_encodings %db_encoding_to_charset);
+use vars qw(@db_encodings %db_encoding_to_charset %charset_to_db_encoding);
+
+use strict;
@db_encodings = (
{ "label" => "ASCII", "dbencoding" => "SQL_ASCII", "charset" => "ASCII" },
use SL::Common;
require Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
-@EXPORT = qw(parse_dbupdate_controls sort_dbupdate_controls);
+our @EXPORT = qw(parse_dbupdate_controls sort_dbupdate_controls);
+
+use strict;
sub parse_dbupdate_controls {
$main::lxdebug->enter_sub();
use Data::Dumper;
use SL::DBUtils;
+use strict;
+
sub delete_transaction {
my ($self, $myconfig, $form) = @_;
$main::lxdebug->enter_sub();
$form->{taxincluded} = 0;
}
- my ($query, $sth);
+ my ($query, $sth, @values, $taxkey, $rate, $posted);
if ($form->{id}) {
# connect to database
my $dbh = $form->dbconnect($myconfig);
- my ($query, $sth, $source, $null);
+ my ($query, $sth, $source, $null, $space);
my ($glwhere, $arwhere, $apwhere) = ("1 = 1", "1 = 1", "1 = 1");
my (@glvalues, @arvalues, @apvalues);
push(@apvalues, $project_id, $project_id);
}
- my ($project_columns, %project_join);
+ my ($project_columns, $project_join);
if ($form->{"l_projectnumbers"}) {
$project_columns = qq|, ac.project_id, pr.projectnumber|;
$project_join = qq|LEFT JOIN project pr ON (ac.project_id = pr.id)|;
}
}
- my $false = ($myconfig->{dbdriver} eq 'Pg') ? FALSE: q|'0'|;
+ my $false = ($myconfig->{dbdriver} eq 'Pg') ? "FALSE" : q|'0'|;
my %sort_columns = (
'id' => [ qw(id) ],
map { $columns_for_sorting{$_} .= sprintf(', lower(%s) AS lower_%s', $lowered_columns{$column}->{$_}, $column) } qw(gl arap);
}
- my $query =
+ $query =
qq|SELECT
ac.acc_trans_id, g.id, 'gl' AS type, $false AS invoice, g.reference, ac.taxkey, c.link,
g.description, ac.transdate, ac.source, ac.trans_id,
my @values = (@glvalues, @arvalues, @apvalues);
# Show all $query in Debuglevel LXDebug::QUERY
- $callingdetails = (caller (0))[3];
- dump_query(LXDebug::QUERY, "$callingdetails", $query, @values);
+ my $callingdetails = (caller (0))[3];
+ dump_query(LXDebug->QUERY(), "$callingdetails", $query, @values);
$sth = prepare_execute_query($form, $dbh, $query, @values);
my $trans_id = "";
my $trans_id2 = "";
+ my $balance;
my ($i, $j, $k, $l, $ref, $ref2);
$form->{GL} = [];
- while (my $ref0 = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref0 = $sth->fetchrow_hashref("NAME_lc")) {
$trans_id = $ref0->{id};
} else { # following lines of a booking, line increasing
$ref2 = $ref0;
- $trans_old = $trans_id2;
+# $trans_old = $trans_id2; # doesn't seem to be used anymore
$trans_id2 = $ref2->{id};
$balance =
if ($form->{id}) {
$query =
qq|SELECT g.reference, g.description, g.notes, g.transdate, g.storno, g.storno_id,
- d.description AS department, e.name AS employee, g.taxincluded, g.gldate,
+ d.description AS department, e.name AS employee, g.taxincluded, g.gldate,
g.ob_transaction, g.cb_transaction
FROM gl g
LEFT JOIN department d ON (d.id = g.department_id)
# now copy acc_trans entries
$query = qq|SELECT * FROM acc_trans WHERE trans_id = ?|;
- my $rowref = selectall_hashref_query($form, $dbh, $query, $id);
+ my $rowref = selectall_hashref_query($form, $dbh, $query, $id);
for my $row (@$rowref) {
delete @$row{qw(itime mtime)};
use SL::MoreCommon;
use List::Util qw(min);
+use strict;
+
sub post_invoice {
$main::lxdebug->enter_sub();
my ($amount, $linetotal, $lastinventoryaccno, $lastexpenseaccno);
my ($netamount, $invoicediff, $expensediff) = (0, 0, 0);
my $exchangerate = 0;
+ my ($basefactor, $baseqty, @taxaccounts, $totaltax);
my $all_units = AM->retrieve_units($myconfig, $form);
$price_factor = $price_factors{ $form->{"price_factor_id_$i"} } || 1;
#####################################################################
# das ist aus IS.pm kopiert. schlimm. jb 7.10.2009
- # ich würde mir wünschen, dass diese vier stellen zusammengefasst werden
+ # ich würde mir wünschen, dass diese vier stellen zusammengefasst werden
# ... vier stellen = (einkauf + verkauf) * (maske + backend)
# ansonsten stolpert man immer wieder viermal statt einmal heftig
# und auch das undo discount formatting ist nicht besonders wartungsfreundlich
-
+
# keep entered selling price
- my $fxsellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"});
+ $fxsellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"});
# keine ahnung wofür das in IS.pm gemacht wird:
# my ($dec) = ($fxsellprice =~ /\.(\d+)/);
$form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100;
# deduct discount
$form->{"sellprice_$i"} = $fxsellprice * (1 - $form->{"discount_$i"});
-
+
######################################################################
if ($form->{"inventory_accno_$i"}) {
ORDER BY transdate|;
$sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{"id_$i"}));
- my $totalqty = $base_qty;
+ my $totalqty = $baseqty;
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
my $qty = min $totalqty, ($ref->{base_qty} + $ref->{allocated});
$linetotal = $form->round_amount(($form->{"sellprice_$i"} * $qty) / $basefactor, 2);
my $netamount = 0;
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
$netamount += $form->round_amount($ref->{sellprice} * $ref->{qty} * -1, 2);
next unless $ref->{inventory_accno_id};
ORDER BY transdate DESC|;
my $sth2 = prepare_execute_query($form, $dbh, $query, $ref->{parts_id});
- while (my $pthref = $sth2->fetchrow_hashref(NAME_lc)) {
+ while (my $pthref = $sth2->fetchrow_hashref("NAME_lc")) {
my $qty = $ref->{allocated};
if (($ref->{allocated} + $pthref->{allocated}) > 0) {
$qty = $pthref->{allocated} * -1;
ORDER BY i.id|;
$sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{id}));
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
# Retrieve custom variables.
my $cvars = CVar->get_custom_variables(dbh => $dbh,
module => 'IC',
$ref->{taxaccounts} = "";
my $i = 0;
- while ($ptr = $stw->fetchrow_hashref(NAME_lc)) {
+ while (my $ptr = $stw->fetchrow_hashref("NAME_lc")) {
if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) {
$i++;
$ptr->{accno} = $i;
LEFT JOIN business b ON (b.id = v.business_id)
LEFT JOIN payment_terms pt ON (v.payment_id = pt.id)
WHERE 1=1 $where|;
- $ref = selectfirst_hashref_query($form, $dbh, $query, @values);
+ my $ref = selectfirst_hashref_query($form, $dbh, $query, @values);
map { $params->{$_} = $ref->{$_} } keys %$ref;
$params->{creditremaining} = $params->{creditlimit};
for $ref (@$refs) {
if ($ref->{category} eq 'E') {
$i++;
-
+ my ($tax_id, $rate);
if ($params->{initial_transdate}) {
my $tax_query = qq|SELECT tk.tax_id, t.rate FROM taxkeys tk
LEFT JOIN tax t ON (tk.tax_id = t.id)
WHERE (tk.chart_id = ?) AND (startdate <= ?)
ORDER BY tk.startdate DESC
LIMIT 1|;
- my ($tax_id, $rate) = selectrow_query($form, $dbh, $tax_query, $ref->{id}, $params->{initial_transdate});
+ ($tax_id, $rate) = selectrow_query($form, $dbh, $tax_query, $ref->{id}, $params->{initial_transdate});
$params->{"taxchart_$i"} = "${tax_id}--${rate}";
}
my $sth = prepare_execute_query($form, $dbh, $query, @values);
$form->{item_list} = [];
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
# In der Buchungsgruppe ist immer ein Bestandskonto verknuepft, auch wenn
# es sich um eine Dienstleistung handelt. Bei Dienstleistungen muss das
delete($ref->{inventory_accno_id});
# get tax rates and description
- $accno_id = ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno};
+ my $accno_id = ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno};
$query =
qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber
FROM tax t
$ref->{taxaccounts} = "";
my $i = 0;
- while ($ptr = $stw->fetchrow_hashref(NAME_lc)) {
+ while (my $ptr = $stw->fetchrow_hashref("NAME_lc")) {
# if ($customertax{$ref->{accno}}) {
if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) {
ORDER BY accno|;
my $sth = prepare_execute_query($query, $dbh, $query);
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
foreach my $key (split(/:/, $ref->{link})) {
if ($key =~ /IC/) {
push @{ $form->{IC_links}{$key} },
package IS;
-#use strict;
-
use List::Util qw(max);
use SL::AM;
use SL::IC;
use Data::Dumper;
+use strict;
+
sub invoice_details {
$main::lxdebug->enter_sub();
use IO::File;
+use strict;
+
sub new {
$main::lxdebug->enter_sub(2);
use SL::Form;
+use strict;
+
sub save_license {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
- $dbh = $form->dbconnect($myconfig);
+ my $dbh = $form->dbconnect($myconfig);
- $query =
+ my $query =
qq| INSERT INTO license (licensenumber) VALUES ('$form->{licensenumber}')|;
- $sth = $dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
$sth->finish();
qq|SELECT l.id FROM license l WHERE l.licensenumber = '$form->{licensenumber}'|;
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
- ($license_id) = $sth->fetchrow_array;
+ my ($license_id) = $sth->fetchrow_array;
$sth->finish();
# save license
my $sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
$form->{"all_customers"} = [];
- while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
push(@{ $form->{"all_customers"} }, $ref);
}
$sth->finish();
$sth = $dbh->prepare($query);
$sth->execute() || $form->dberror($query);
$form->{"licenses"} = [];
- while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
push(@{ $form->{"licenses"} }, $ref);
}
. $form->{"id"};
$sth = $dbh->prepare($query);
$sth->execute() || $form->dberror($query);
- $form->{"license"} = $sth->fetchrow_hashref(NAME_lc);
+ $form->{"license"} = $sth->fetchrow_hashref("NAME_lc");
$sth->finish();
$dbh->disconnect();
$main::lxdebug->leave_sub();
use SL::Common;
use SL::Inifile;
+use strict;
+
sub new {
$main::lxdebug->enter_sub();
my $longdate = "";
my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
+ my ($spc, $yy, $mm, $dd);
+
if ($date) {
# get separator
$main::lxdebug->enter_sub();
my ($self, $myconfig, $date, $longformat) = @_;
+ my ($spc, $yy, $mm, $dd);
unless ($date) {
$main::lxdebug->leave_sub();
package SL::MoreCommon;
require Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
-@EXPORT = qw(save_form restore_form compare_numbers any cross);
-@EXPORT_OK = qw(ary_union ary_intersect ary_diff listify);
+our @EXPORT = qw(save_form restore_form compare_numbers any cross);
+our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify);
use YAML;
use SL::AM;
+use strict;
+
sub save_form {
$main::lxdebug->enter_sub();
use SL::DBUtils;
use SL::CVar;
+use strict;
+
my %project_id_column_prefixes = ("ar" => "global",
"ap" => "global",
"oe" => "global",
$params{active} = 1;
}
- $query = qq|UPDATE project SET projectnumber = ?, description = ?, active = ?
+ my $query = qq|UPDATE project SET projectnumber = ?, description = ?, active = ?
WHERE id = ?|;
@values = ($params{projectnumber}, $params{description}, $params{active} ? 't' : 'f', conv_i($params{id}));
use SL::DBUtils;
+use strict;
+
sub paymentaccounts {
$main::lxdebug->enter_sub();
use Data::Dumper;
use List::Util qw(reduce);
+use strict;
+
sub create_links {
$main::lxdebug->enter_sub();
use SL::Form;
+use strict;
+
# Cause locales.pl to parse these files:
# parse_html_template('report_generator/html_report')
$report->add_data($row1, $row2, @more_rows);
$report->generate_with_headers();
-This creates a report object, sets a few columns, adds some data and generates a standard report.
+This creates a report object, sets a few columns, adds some data and generates a standard report.
Sorting of columns will be alphabetic, and options will be set to their defaults.
The report will be printed including table headers, html headers and http headers.
Then it lacks usability. You want it to be able to sort the data. You add code for that.
Then there are too many results, you need pagination, you want to print or export that data..... and so on.
-The ReportGenerator class was designed because this exact scenario happened about half a dozen times in Lx-Office.
-It's purpose is to manage all those formating, culling, sorting, and templating.
+The ReportGenerator class was designed because this exact scenario happened about half a dozen times in Lx-Office.
+It's purpose is to manage all those formating, culling, sorting, and templating.
Which makes it almost as complicated to use as doing the work for yourself.
=head1 FUNCTIONS
=item add_data \%data
-Adds data to the report. A given hash_ref is interpreted as a single line of data, every array_ref as a collection of lines.
-Every line will be expected to be in a kay => value format. Note that the rows have to be already sorted.
+Adds data to the report. A given hash_ref is interpreted as a single line of data, every array_ref as a collection of lines.
+Every line will be expected to be in a kay => value format. Note that the rows have to be already sorted.
ReportGenerator does only colum sorting on its own, and provides links to sorting and visual cue as to which column was sorted by.
=item add_separator
=item add_control \%data
Adds a control element to the data. Control elements are an experimental feature to add functionality to a report the regular data cannot.
-Every control element needs to set IS_CONTROL_DATA, in order to be recongnized by the template.
+Every control element needs to set IS_CONTROL_DATA, in order to be recongnized by the template.
Currently the only control element is a colspan element, which can be used as a mini header further down the report.
=item clear_data
=item generate_with_headers
-Parses the report, adds headers and prints it out. Headers depend on the option 'output_format',
+Parses the report, adds headers and prints it out. Headers depend on the option 'output_format',
for example 'HTML' will add proper table headers, html headers and http headers. See configuration for this option.
=item get_visible_columns $format
=item prepare_html_content $column,$name,@column_headers
-Parses the data, and sets internal data needed for certain output format. Must be called once before the template is invoked.
+Parses the data, and sets internal data needed for certain output format. Must be called once before the template is invoked.
Should not be called extrenally, since all render and generate functions invoke it anyway.
-
+
=item generate_html_content
The html generation function. Is invoked by generate_with_headers.
Landscape or portrait. Default is landscape.
-=item font_name
+=item font_name
Default is Verdana. Supported font names are Courier, Georgia, Helvetica, Times and Verdana. This option only affects the rendering with PDF::API2.
use SL::DBUtils;
+use strict;
+
sub get_user_config {
$main::lxdebug->enter_sub();
use SL::DBUtils;
+use strict;
+
my @tax_office_information = (
{ 'id' => 8, 'name' => 'Baden Württemberg', 'taxbird_nr' => '0', 'elster_format' => 'FF/BBB/UUUUP', },
{ 'id' => 9, 'name' => 'Bayern', 'taxbird_nr' => '1', 'elster_format' => 'FFF/BBB/UUUUP', },
sub create_steuernummer {
$main::lxdebug->enter_sub();
- $part = $form->{part};
- $patterncount = $form->{patterncount};
- $delimiter = $form->{delimiter};
- $elster_pattern = $form->{elster_pattern};
+ my $form = $main::form;
+
+ our ($elster_FFFF);
+
+ my $part = $form->{part};
+ my $patterncount = $form->{patterncount};
+ my $delimiter = $form->{delimiter};
+ my $elster_pattern = $form->{elster_pattern};
# rebuild steuernummer and elstersteuernummer
# es gibt eine gespeicherte steuernummer $form->{steuernummer}
my $h = 0;
my $i = 0;
- $steuernummer_new = $part;
- $elstersteuernummer_new = $elster_FFFF;
- $elstersteuernummer_new .= '0';
+ my $steuernummer_new = $part;
+ my $elstersteuernummer_new = $elster_FFFF;
+ $elstersteuernummer_new .= '0';
for ($h = 1; $h < $patterncount; $h++) {
$steuernummer_new .= qq|$delimiter|;
$main::lxdebug->enter_sub();
my ($self, $elsterland, $elsterFFFF, $steuernummer) = @_;
+ our ($elster_FFFF, $elster_land);
my $steuernummer_input = '';
my $ffff = '';
my $checked = '';
$checked = 'checked' if ($elsterFFFF eq '' and $land eq '');
+ my %elster_land_fa;
my $fa_auswahl = qq|
<script language="Javascript">
elsterFAAuswahl.options.length = 0; // dropdown aufräumen
|;
- foreach $elster_land (sort keys %$elster_init) {
+ foreach my $elster_land (sort keys %$elster_init) {
$fa_auswahl .= qq|
if (elsterBLAuswahl.options[elsterBLAuswahl.selectedIndex].
value == "$elster_land")
{
|;
my $j = 0;
- my %elster_land_fa = ();
+ %elster_land_fa = ();
$FFFF = '';
for $FFFF (keys %{ $elster_init->{$elster_land} }) {
$elster_land_fa{$FFFF} = $elster_init->{$elster_land}->{$FFFF}->[0];
if ($land eq '') {
$fa_auswahl .= qq|<option value="Auswahl" $checked>| . $main::locale->text('Select federal state...') . qq|</option>\n|;
}
- foreach $elster_land (sort keys %$elster_init) {
+ foreach my $elster_land (sort keys %$elster_init) {
$fa_auswahl .= qq|
<option value="$elster_land"|;
if ($elster_land eq $land and $checked eq '') {
$main::lxdebug->leave_sub();
}
+# 20.10.2009 sschoeling: this sub seems to be orphaned.
sub stichtag {
$main::lxdebug->enter_sub();
#$today =today * 1;
$today =~ /(\d\d\d\d)(\d\d)(\d\d)/;
- $year = $1;
- $month = $2;
- $day = $3;
- $yy = $year;
- $mm = $month;
- $yymmdd = "$year$month$day" * 1;
- $mmdd = "$month$day" * 1;
- $stichtag = '';
+ my $year = $1;
+ my $month = $2;
+ my $day = $3;
+ my $yy = $year;
+ my $mm = $month;
+ my $yymmdd = "$year$month$day" * 1;
+ my $mmdd = "$month$day" * 1;
+ my $stichtag = '';
#$tage_bis = '1234';
#$ical = '...vcal format';
#if ($FA_voranmeld eq 'month'){
- %liste = ("0110" => 'December',
- "0210" => 'January',
- "0310" => 'February',
- "0410" => 'March',
- "0510" => 'April',
- "0610" => 'May',
- "0710" => 'June',
- "0810" => 'July',
- "0910" => 'August',
- "1010" => 'September',
- "1110" => 'October',
- "1210" => 'November');
+ my %liste = (
+ "0110" => 'December',
+ "0210" => 'January',
+ "0310" => 'February',
+ "0410" => 'March',
+ "0510" => 'April',
+ "0610" => 'May',
+ "0710" => 'June',
+ "0810" => 'July',
+ "0910" => 'August',
+ "1010" => 'September',
+ "1110" => 'October',
+ "1210" => 'November',
+ );
#$mm += $dauerfrist
#$month *= 1;
$month += 1 if ($day > 10);
$month = sprintf("%02d", $month);
$stichtag = $year . $month . "10";
- $ust_va = $month . "10";
+ my $ust_va = $month . "10";
- foreach $date (%liste) {
+ foreach my $date (%liste) {
$ust_va = $liste{$date} if ($date eq $stichtag);
}
#$stichtag =~ /([\d]\d)(\d\d)$/
#$stichtag = "$1.$2.$yy"
#$stichtag=$1;
+ our $description; # most probably not existant.
+ our $tage_bis; # most probably not existant.
+ our $ical; # most probably not existant.
+
$main::lxdebug->leave_sub();
return ($stichtag, $description, $tage_bis, $ical);
}
$sth->execute || $form->dberror($query);
my $array_ref = $sth->fetchall_arrayref();
my $land = '';
+ my %finanzamt;
foreach my $row (@$array_ref) {
my $FA_finanzamt = $row;
my $tax_office = first { $_->{id} == $FA_finanzamt->[0] } @{ $self->{tax_office_information} };
$form->{decimalplaces} *= 1;
- foreach $item (@category_cent) {
+ foreach my $item (@category_cent) {
$form->{"$item"} = 0;
}
- foreach $item (@category_euro) {
+ foreach my $item (@category_euro) {
$form->{"$item"} = 0;
}
my $coa_name = coa_get($dbh);
# Controlvariable for templates
$form->{"$coa_name"} = '1';
- $main::lxdebug->message(LXDebug::DEBUG2, "COA: '$form->{coa}', \$form->{$coa_name} = 1");
+ $main::lxdebug->message(LXDebug->DEBUG2(), "COA: '$form->{coa}', \$form->{$coa_name} = 1");
&get_accounts_ustva($dbh, $last_period, $form->{fromdate}, $form->{todate},
$form, $category);
sub coa_get {
my ($dbh) = @_;
+ my $form = $main::form;
my $query= qq|SELECT coa FROM defaults|;
$sth->execute || $form->dberror($query);
- ($ref) = $sth->fetchrow_array;
+ my ($ref) = $sth->fetchrow_array;
return $ref;
$main::lxdebug->enter_sub();
my ($dbh, $last_period, $fromdate, $todate, $form, $category) = @_;
+ our ($dpt_join);
my $query;
my $where = "";
my $ref;
# Show all $query in Debuglevel LXDebug::QUERY
- $callingdetails = (caller (0))[3];
- $main::lxdebug->message(LXDebug::QUERY, "$callingdetails \$query=\n $query");
+ my $callingdetails = (caller (0))[3];
+ $main::lxdebug->message(LXDebug->QUERY(), "$callingdetails \$query=\n $query");
my $sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+ while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
# Bug 365 solved?!
$ref->{amount} *= -1;
$form->{ $ref->{$category} } += $ref->{amount};
my ($self, $userspath, $filename) = @_;
- $form->error("Missing Parameter: @_") if !$userspath || !$filename;
-
my $form = $main::form;
+ $form->error("Missing Parameter: @_") if !$userspath || !$filename;
+
$filename = "$form->{login}_$filename";
$filename =~ s|.*/||;
$filename = "$userspath/$filename";
- open my $FACONF, "<", $filename or sub {# Annon Sub
+ open my $FACONF, "<", $filename or do {# Annon Sub
# catch open error
# create file if file does not exist
open my $FANEW, ">", $filename or $form->error("CREATE: $filename : $!");
$dbh->begin_work();
+ # setup dbup_ export vars
my %dbup_myconfig = ();
map({ $dbup_myconfig{$_} = $form->{$_}; }
qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
require Tie::Hash;
-@ISA = (Tie::StdHash);
+our @ISA = qw(Tie::StdHash);
+
+use strict;
my %watched_variables;
###################
+use strict;
+
die("This script cannot be run from the command line.") unless ($main::form);
+# import vars from caller
+our ($dbup_locale, $dbup_myconfig, $dbh, $iconv);
+
sub mydberror {
my ($msg) = @_;
die($dbup_locale->text("Database update error:") .
# @description: USTVA Report Daten fuer Oesterreich. Vielen Dank an Gerhard Winkler..
# @depends: USTVA_abstraction
-unless ( $main::form ) {
+use strict;
+
+unless ( $main::form ) {
die("This script cannot be run from the command line.");
}
+# import vars from caller
+our ($dbup_locale, $dbup_myconfig, $dbh, $iconv);
+
if ( check_coa('Austria') ){
if ( coa_is_empty() ) {
print qq|Eine leere Datenbank mit Kontenrahmen Österreich vorgefunden. <br />
Die Aktualisierungen werden eingespielt...<br />
<b>Achtung: Dieses Update ist ungetestet und bedarf weiterer Konfiguration</b>|;
-
+
return 1
- && clear_tables(( 'tax.report_variables', 'tax.report_headings',
- 'tax.report_categorys', 'taxkeys',
+ && clear_tables(( 'tax.report_variables', 'tax.report_headings',
+ 'tax.report_categorys', 'taxkeys',
'tax', 'chart',
'buchungsgruppen',
))
&& do_insert_taxkeys()
&& do_insert_buchungsgruppen()
;
- }
+ }
else {
- print qq|Eine österreichische Datenbank in der bereits Buchungssätze enthalten sind, kann nicht aktualisiert werden.<br />
+ print qq|Eine österreichische Datenbank in der bereits Buchungssätze enthalten sind, kann nicht aktualisiert werden.<br />
Bitte eine neue Datenbank mit Kontenrahmen 'Austria' anlegen.|;
return 1;
}
}
sub check_coa {
-
+
my ( $want_coa ) = @_;
-
+
my $query = q{ SELECT count(*) FROM defaults WHERE coa = ? };
- my ($have_coa) = selectrow_query($form, $dbh, $query, $want_coa);
+ my ($have_coa) = selectrow_query($main::form, $dbh, $query, $want_coa);
return $have_coa;
}
sub coa_is_empty {
-
- my $query = q{ SELECT count(*)
+
+ my $query = q{ SELECT count(*)
FROM ar, ap, gl, invoice, acc_trans, customer, vendor, parts
};
- my ($empty) = selectrow_query($form, $dbh, $query);
+ my ($empty) = selectrow_query($main::form, $dbh, $query);
$empty = !$empty;
"INSERT INTO tax.report_headings (id, category_id, type, description, subdescription) VALUES (0, 0, NULL, NULL, NULL)",
);
- map({ do_query($_); } @queries);
+ map({ do_query($_); } @queries);
my @copy_statements = (
"INSERT INTO tax.report_variables (id, position, heading_id, description, dec_places, valid_from) VALUES (?, ?, ?, ?, ?, ?)",
);
-
+
my @copy_data = (
- [
+ [
"1;000;0;a) Gesamtbetrag der Bemessungsgrundlage für Lieferungen und sonstige Leistungen (ohne den nachstehend angeführten Eigenverbrauch) einschließlich Anzahlungen (jeweils ohne Umsatzsteuer);2;1970-01-01",
"2;001;0;zuzüglich Eigenverbrauch (§1 Abs. 1 Z 2, § 3 Abs. 2 und § 3a Abs. 1a);2;1970-01-01",
"3;021;0;abzüglich Umsätze für die die Steuerschuld gemäß § 19 Abs. 1 zweiter Satz sowie gemäß § 19 Abs. 1a, Abs. 1b, Abs. 1c auf den Leistungsempfänger übergegangen ist.;2;1970-01-01",
return 1;
}
sub do_insert_tax {
-
+
my @copy_statements = (
"INSERT INTO tax (chart_id, taxnumber, taxkey, taxdescription, itime, mtime, rate, id) VALUES (65, '2510', 7, 'Vorsteuer 10%', '2006-01-30 11:08:23.332857', '2006-02-08 20:28:09.63567', 0.10000, 173);",
"INSERT INTO tax (chart_id, taxnumber, taxkey, taxdescription, itime, mtime, rate, id) VALUES (64, '2512', 8, 'Vorsteuer 12%', '2006-02-02 17:39:18.535036', '2006-02-08 20:28:21.463869', 0.12000, 174);",
"INSERT INTO tax (chart_id, taxnumber, taxkey, taxdescription, itime, mtime, rate, id) VALUES (NULL, NULL, 10, 'Im anderen EG-Staat steuerpfl. Lieferung', '2006-01-30 11:08:23.332857', '2006-02-08 12:45:36.44088', NULL, 171);",
"INSERT INTO tax (chart_id, taxnumber, taxkey, taxdescription, itime, mtime, rate, id) VALUES (NULL, NULL, 11, 'Steuerfreie EG-Lief. an Abn. mit UStIdNr', '2006-01-30 11:08:23.332857', '2006-02-08 12:45:36.44088', NULL, 172);",
"INSERT INTO tax (chart_id, taxnumber, taxkey, taxdescription, itime, mtime, rate, id) VALUES (NULL, NULL, 0, 'Keine Steuer', '2006-01-30 11:08:23.332857', '2006-02-08 12:45:36.44088', 0.00000, 0);",
-
+
);
for my $statement ( 0 .. $#copy_statements ) {
}
sub do_insert_taxkeys {
-
+
my @copy_statements = (
"INSERT INTO taxkeys VALUES (230, 69, 177, 2, NULL, '1970-01-01');",
"INSERT INTO taxkeys VALUES (231, 72, 178, 3, NULL, '1970-01-01');",
"UPDATE taxkeys SET pos_ustva='017' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('4015', '4025', '4035', '4045', '4315', '4325', '4335', '4345'));",
"UPDATE taxkeys SET pos_ustva='022' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('4040', '4045'));",
"UPDATE taxkeys SET pos_ustva='122' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('3520'));",
- "UPDATE taxkeys SET pos_ustva='029' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('4010', '4015'));",
+ "UPDATE taxkeys SET pos_ustva='029' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('4010', '4015'));",
"UPDATE taxkeys SET pos_ustva='129' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('3510'));",
"UPDATE taxkeys SET pos_ustva='025' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('4012'));",
"UPDATE taxkeys SET pos_ustva='125' WHERE chart_id IN (SELECT id FROM chart WHERE accno IN ('3512'));",
# @description: Migration of cp_greeting to cp_gender
# @depends: generic_translations
+use strict;
+
die("This script cannot be run from the command line.") unless ($main::form);
+# import vars from caller
+our ($dbup_locale, $dbup_myconfig, $dbh, $iconv);
sub mydberror {
my ($msg) = @_;
# list of all entries where cp_greeting is empty, meaning can't determine gender from parsing Herr/Frau/...
# this assumes cp_greeting still exists, i.e. gender.sql was not run yet
- my $gender_table;
+ my ($gender_table, $mchecked, $fchecked);
my $sql2 = "select cp_id,cp_givenname,cp_name,cp_title,cp_greeting from contacts where not (cp_greeting ILIKE '%frau%' OR cp_greeting ILIKE '%herr%' or cp_greeting ILIKE '%mrs.%' or cp_greeting ILIKE '%miss%') ";
my $sth2 = $dbh->prepare($sql2) or die $dbh->errstr();
- $sth2->execute() or die $dbh->errstr();
+ $sth2->execute() or die $dbh->errstr();
- my $i = 1;
+ my $i = 1;
$gender_table .= '<table border="1"><tr><th>cp_givenname</th><th>cp_name</th><th>cp_title</th><th>cp_greeting</th><th><translate>male/female</th></tr>';
$gender_table .= "\n";
while (my $row = $sth2->fetchrow_hashref()) {
- if ( main::form->{"gender_$i"} eq "f" ) {
+ if ($main::form->{"gender_$i"} eq "f" ) {
$mchecked = "";
$fchecked = "checked";
} else {
$mchecked = "checked";
$fchecked = "";
};
-
+
$gender_table .= "<tr><input type=hidden name=\"cp_id_$i\" value=\"$row->{cp_id}\"> <td>$row->{cp_givenname}</td> <td>$row->{cp_name}</td> <td>$row->{cp_title} </td> <td>$row->{cp_greeting} </td><td> <input type=\"radio\" name=\"gender_$i\" value=\"m\" $mchecked> <input type=\"radio\" name=\"gender_$i\" value=\"f\" $fchecked></td></tr>\n";
$i++;
};
- $gender_table .= "<input type=hidden name=\"number_of_gender_entries\" value=\"$i\">";
+ $gender_table .= "<input type=hidden name=\"number_of_gender_entries\" value=\"$i\">";
$gender_table .= "</table>";
$main::form->{gender_table} = $gender_table;
my $title_table;
-
+
my $sql3 = "select cp_id,cp_givenname,cp_name,cp_title,cp_greeting from contacts where not ( (cp_greeting ILIKE '%frau%' OR cp_greeting ILIKE '%herr%' or cp_greeting ILIKE '%mrs.%' or cp_greeting ILIKE '%miss%')) and not (cp_greeting like ''); ";
my $sth3 = $dbh->prepare($sql3) or die $dbh->errstr();
- $sth3->execute() or die $dbh->errstr();
+ $sth3->execute() or die $dbh->errstr();
$title_table = '<table border="1"><tr><th>cp_givenname</th><th>cp_name</th><th>cp_title</th><th>cp_greeting</th><th>cp_title new</th></tr>';
$j++;
};
- $title_table .= "<input type=hidden name=\"number_of_title_entries\" value=\"$j\">";
+ $title_table .= "<input type=hidden name=\"number_of_title_entries\" value=\"$j\">";
$title_table .= "</table>";
$main::form->{title_table} = $title_table;
# @description: Neue Spalte für eine globale Projektnummer in Einkaufs- und Verkaufsbelegen
# @depends: release_2_4_1
+use strict;
+
+# import vars from caller
+our ($dbup_locale, $dbup_myconfig, $dbh);
+
die("This script cannot be run from the command line.") unless ($main::form);
sub mydberror {
# @description: Diverse neue Tabellen und Spalten zur Mehrlagerfähigkeit inkl. Migration
# @depends: release_2_4_3
+use strict;
die("This script cannot be run from the command line.") unless ($main::form);
+# import vars from caller
+our ($dbup_locale, $dbup_myconfig, $dbh, $iconv);
+my $do_sql_migration = 0;
+my ($check_sql, $sqlcode);
+
sub mydberror {
my ($msg) = @_;
die($dbup_locale->text("Database update error:") .
}
}
-$do_sql_migration = 0;
sub print_question {
print $main::form->parse_html_template("dbupgrade/warehouse_form");
UPDATE tmp_parts SET bin = NULL WHERE bin = '';
-- Restore old onhand
-INSERT INTO bin
- (warehouse_id, description)
- (SELECT DISTINCT warehouse.id, COALESCE(bin, $bin)
- FROM warehouse, tmp_parts
+INSERT INTO bin
+ (warehouse_id, description)
+ (SELECT DISTINCT warehouse.id, COALESCE(bin, $bin)
+ FROM warehouse, tmp_parts
WHERE warehouse.description=$warehouse);
-INSERT INTO inventory
+INSERT INTO inventory
(warehouse_id, parts_id, bin_id, qty, employee_id, trans_id, trans_type_id, chargenumber)
(SELECT warehouse.id, tmp_parts.id, bin.id, onhand, (SELECT id FROM employee LIMIT 1), nextval('id'), transfer_type.id, ''
FROM transfer_type, warehouse, tmp_parts, bin
WHERE warehouse.description = $warehouse
- AND COALESCE(bin, $bin) = bin.description
+ AND COALESCE(bin, $bin) = bin.description
AND transfer_type.description = 'stock');
EOF
;
projects / kivitendo-erp.git / commitdiff