X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/7bd555b62a7501d750d7989b75b46a40c5e7c1a3..61d89baf2eb6f0524c6b2eb561df2687e07ad6c8:/SL/Form.pm diff --git a/SL/Form.pm b/SL/Form.pm index cfffd78e2..20acf122c 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -243,33 +243,24 @@ sub new { tie %{ $self }, 'SL::Watchdog'; } - read(STDIN, $_, $ENV{CONTENT_LENGTH}); + bless $self, $type; - if ($ENV{QUERY_STRING}) { - $_ = $ENV{QUERY_STRING}; - } + $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; + $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; - if ($ARGV[0]) { - $_ = $ARGV[0]; + if ($ENV{CONTENT_LENGTH}) { + my $content; + read STDIN, $content, $ENV{CONTENT_LENGTH}; + $self->_request_to_hash($content); } - bless $self, $type; - - $self->_request_to_hash($_); - my $db_charset = $main::dbcharset; $db_charset ||= Common::DEFAULT_CHARSET; - if ($self->{INPUT_ENCODING}) { - if (lc $self->{INPUT_ENCODING} ne lc $db_charset) { - require Text::Iconv; - my $iconv = Text::Iconv->new($self->{INPUT_ENCODING}, $db_charset); - - _recode_recursively($iconv, $self); - } + my $encoding = $self->{INPUT_ENCODING} || $db_charset; + delete $self->{INPUT_ENCODING}; - delete $self->{INPUT_ENCODING}; - } + _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self); $self->{action} = lc $self->{action}; $self->{action} =~ s/( |-|,|\#)/_/g; @@ -475,13 +466,13 @@ sub info { if (!$self->{header}) { $self->header; - print qq| - |; + print qq||; } print qq| - -

$msg +

$msg

+ + |; } else { @@ -558,6 +549,20 @@ sub _get_request_uri { return $uri; } +sub _add_to_request_uri { + my $self = shift; + + my $relative_new_path = shift; + my $request_uri = shift || $self->_get_request_uri; + my $relative_new_uri = URI->new($relative_new_path); + my @request_segments = $request_uri->path_segments; + + my $new_uri = $request_uri->clone; + $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments); + + return $new_uri; +} + sub create_http_response { $main::lxdebug->enter_sub(); @@ -836,39 +841,42 @@ sub parse_html_template { $additional_params ||= { }; - $file = $self->_prepare_html_template($file, $additional_params); - - my $template = Template->new({ 'INTERPOLATE' => 0, - 'EVAL_PERL' => 0, - 'ABSOLUTE' => 1, - 'CACHE_SIZE' => 0, - 'PLUGIN_BASE' => 'SL::Template::Plugin', - 'INCLUDE_PATH' => '.:templates/webpages', - }) || die; + my $real_file = $self->_prepare_html_template($file, $additional_params); + my $template = $self->template || $self->init_template; map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; - my $in = IO::File->new($file, 'r'); - - if (!$in) { - print STDERR "Error opening template file: $!"; - $main::lxdebug->leave_sub(); - return ''; - } - - my $input = join('', <$in>); - $in->close(); - my $output; - if (!$template->process(\$input, $additional_params, \$output)) { - print STDERR $template->error(); - } + $template->process($real_file, $additional_params, \$output) || die $template->error; $main::lxdebug->leave_sub(); return $output; } +sub init_template { + my $self = shift; + + return if $self->template; + + return $self->template(Template->new({ + 'INTERPOLATE' => 0, + 'EVAL_PERL' => 0, + 'ABSOLUTE' => 1, + 'CACHE_SIZE' => 0, + 'PLUGIN_BASE' => 'SL::Template::Plugin', + 'INCLUDE_PATH' => '.:templates/webpages', + 'COMPILE_EXT' => '.tcc', + 'COMPILE_DIR' => $::userspath . '/templates-cache', + })) || die; +} + +sub template { + my $self = shift; + $self->{template_object} = shift if @_; + return $self->{template_object}; +} + sub show_generic_error { $main::lxdebug->enter_sub(); @@ -1184,7 +1192,7 @@ sub parse_template { $main::lxdebug->enter_sub(); my ($self, $myconfig, $userspath) = @_; - my ($template, $out); + my $out; local (*IN, *OUT); @@ -1193,31 +1201,29 @@ sub parse_template { my $ext_for_format; + my $template_type; if ($self->{"format"} =~ /(opendocument|oasis)/i) { - $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'OpenDocument'; $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt'; } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; - $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'LaTeX'; $ext_for_format = 'pdf'; } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { - $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'HTML'; $ext_for_format = 'html'; } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'XML'; $ext_for_format = 'xml'; - } elsif ( $self->{"format"} =~ /elsterwinston/i ) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - - } elsif ( $self->{"format"} =~ /elstertaxbird/i ) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) { + $template_type = 'xml'; } elsif ( $self->{"format"} =~ /excel/i ) { - $template = ExcelTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'Excel'; $ext_for_format = 'xls'; } elsif ( defined $self->{'format'}) { @@ -1230,6 +1236,12 @@ sub parse_template { $self->error("Outputformat not defined: $self->{'format'}"); } + my $template = SL::Template::create(type => $template_type, + file_name => $self->{IN}, + form => $self, + myconfig => $myconfig, + userspath => $userspath); + # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be. $self->{"notes"} = $self->{ $self->{"formname"} . "notes" }; @@ -1262,20 +1274,23 @@ sub parse_template { $self->{OUT} = ">$self->{tmpfile}"; } + my $result; + if ($self->{OUT}) { - open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); + open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!"); + $result = $template->parse(*OUT); + close OUT; + } else { - open(OUT, ">-") or $self->error("STDOUT : $!"); $self->header; + $result = $template->parse(*STDOUT); } - if (!$template->parse(*OUT)) { + if (!$result) { $self->cleanup(); $self->error("$self->{IN} : " . $template->get_error()); } - close(OUT); - if ($template->uses_temp_file() || $self->{media} eq 'email') { if ($self->{media} eq 'email') { @@ -1339,8 +1354,11 @@ sub parse_template { #print(STDERR "OUT $self->{OUT}\n"); for my $i (1 .. $self->{copies}) { if ($self->{OUT}) { - open(OUT, $self->{OUT}) - or $self->error($self->cleanup . "$self->{OUT} : $!"); + open OUT, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT while ; + close OUT; + seek IN, 0, 0; + } else { $self->{attachment_filename} = ($self->{attachment_filename}) ? $self->{attachment_filename} @@ -1353,18 +1371,8 @@ Content-Length: $numbytes |; - open(OUT, ">-") or $self->error($self->cleanup . "$!: STDOUT"); - + $::locale->with_raw_io(\*STDOUT, sub { print while }); } - - while () { - print OUT $_; - - } - - close(OUT); - - seek IN, 0, 0; } close(IN); @@ -1539,15 +1547,21 @@ sub datetonum { # Database routines used throughout +sub _dbconnect_options { + my $self = shift; + my $options = { pg_enable_utf8 => $::locale->is_utf8, + @_ }; + + return $options; +} + sub dbconnect { $main::lxdebug->enter_sub(2); my ($self, $myconfig) = @_; # connect to database - my $dbh = - DBI->connect($myconfig->{dbconnect}, - $myconfig->{dbuser}, $myconfig->{dbpasswd}) + my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options) or $self->dberror; # set db options @@ -1566,9 +1580,7 @@ sub dbconnect_noauto { my ($self, $myconfig) = @_; # connect to database - my $dbh = - DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, - $myconfig->{dbpasswd}, { AutoCommit => 0 }) + my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0)) or $self->dberror; # set db options @@ -1584,7 +1596,8 @@ sub dbconnect_noauto { sub get_standard_dbh { $main::lxdebug->enter_sub(2); - my ($self, $myconfig) = @_; + my $self = shift; + my $myconfig = shift || \%::myconfig; if ($standard_dbh && !$standard_dbh->{Active}) { $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); @@ -1785,8 +1798,9 @@ sub check_exchangerate { sub get_all_currencies { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; - my $dbh = $self->get_standard_dbh($myconfig); + my $self = shift; + my $myconfig = shift || \%::myconfig; + my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT curr FROM defaults|; @@ -2361,9 +2375,13 @@ sub _get_customers { my $options = ref $key eq 'HASH' ? $key : { key => $key }; $options->{key} ||= "all_customers"; my $limit_clause = "LIMIT $options->{limit}" if $options->{limit}; - my $where = $options->{business_is_salesman} ? qq| AND business_id IN (SELECT id FROM business WHERE salesman)| : ''; - my $query = qq|SELECT * FROM customer WHERE NOT obsolete $where ORDER BY name $limit_clause|; + my @where; + push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman}; + push @where, qq|NOT obsolete| if !$options->{with_obsolete}; + my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : ''; + + my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|; $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); @@ -2625,7 +2643,7 @@ sub all_vc { my ($self, $myconfig, $table, $module) = @_; my $ref; - my $dbh = $self->get_standard_dbh($myconfig); + my $dbh = $self->get_standard_dbh; $table = $table eq "customer" ? "customer" : "vendor"; @@ -3033,8 +3051,8 @@ sub lastname_used { sub current_date { $main::lxdebug->enter_sub(); - my $self = shift; - my $myconfig = shift || \%::myconfig; + my $self = shift; + my $myconfig = shift || \%::myconfig; my ($thisdate, $days) = @_; my $dbh = $self->get_standard_dbh($myconfig); @@ -3237,8 +3255,8 @@ sub save_status { sub save_history { $main::lxdebug->enter_sub(); - my $self = shift(); - my $dbh = shift(); + my $self = shift; + my $dbh = shift || $self->get_standard_dbh; if(!exists $self->{employee_id}) { &get_employee($self, $dbh); @@ -3251,6 +3269,8 @@ sub save_history { $self->{addition}, $self->{what_done}, "$self->{snumbers}"); do_query($self, $dbh, $query, @values); + $dbh->commit; + $main::lxdebug->leave_sub(); }