use SL::DO;
use SL::IC;
use SL::IS;
+use SL::Locale;
use SL::Mailer;
use SL::Menu;
+use SL::MoreCommon qw(uri_encode uri_decode);
use SL::OE;
+use SL::Request;
use SL::Template;
use SL::User;
use SL::X;
undef $standard_dbh;
}
-sub _store_value {
- $main::lxdebug->enter_sub(2);
-
- my $self = shift;
- my $key = shift;
- my $value = shift;
-
- my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key;
-
- my $curr;
-
- if (scalar @tokens) {
- $curr = \ $self->{ shift @tokens };
- }
-
- while (@tokens) {
- my $sep = shift @tokens;
- my $key = shift @tokens;
-
- $curr = \ $$curr->[++$#$$curr], next if $sep eq '[]';
- $curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].';
- $curr = \ $$curr->[++$#$$curr] if $sep eq '[+].';
- $curr = \ $$curr->{$key}
- }
-
- $$curr = $value;
-
- $main::lxdebug->leave_sub(2);
-
- return $curr;
-}
-
-sub _input_to_hash {
- $main::lxdebug->enter_sub(2);
-
- my $self = shift;
- my $input = shift;
-
- my @pairs = split(/&/, $input);
-
- foreach (@pairs) {
- my ($key, $value) = split(/=/, $_, 2);
- $self->_store_value($self->unescape($key), $self->unescape($value)) if ($key);
- }
-
- $main::lxdebug->leave_sub(2);
-}
-
-sub _request_to_hash {
- $main::lxdebug->enter_sub(2);
-
- my $self = shift;
- my $input = shift;
- my $uploads = {};
-
- if (!$ENV{'CONTENT_TYPE'}
- || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
-
- $self->_input_to_hash($input);
-
- $main::lxdebug->leave_sub(2);
- return $uploads;
- }
-
- my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
-
- my $boundary = '--' . $1;
-
- foreach my $line (split m/\n/, $input) {
- last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));
-
- if (($line eq $boundary) || ($line eq "$boundary\r")) {
- ${ $previous } =~ s|\r?\n$|| if $previous;
-
- undef $previous;
- undef $filename;
-
- $headers_done = 0;
- $content_type = "text/plain";
- $boundary_found = 1;
- $need_cr = 0;
-
- next;
- }
-
- next unless $boundary_found;
-
- if (!$headers_done) {
- $line =~ s/[\r\n]*$//;
-
- if (!$line) {
- $headers_done = 1;
- next;
- }
-
- if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) {
- if ($line =~ m|filename\s*=\s*"(.*?)"|i) {
- $filename = $1;
- substr $line, $-[0], $+[0] - $-[0], "";
- }
-
- if ($line =~ m|name\s*=\s*"(.*?)"|i) {
- $name = $1;
- substr $line, $-[0], $+[0] - $-[0], "";
- }
-
- $previous = _store_value($uploads, $name, '') if ($name);
- $self->{FILENAME} = $filename if ($filename);
-
- next;
- }
-
- if ($line =~ m|^content-type\s*:\s*(.*?)$|i) {
- $content_type = $1;
- }
-
- next;
- }
-
- next unless $previous;
-
- ${ $previous } .= "${line}\n";
- }
-
- ${ $previous } =~ s|\r?\n$|| if $previous;
-
- $main::lxdebug->leave_sub(2);
-
- return $uploads;
-}
-
-sub _recode_recursively {
- $main::lxdebug->enter_sub();
- my ($iconv, $param) = @_;
-
- if (any { ref $param eq $_ } qw(Form HASH)) {
- foreach my $key (keys %{ $param }) {
- if (!ref $param->{$key}) {
- # Workaround for a bug: converting $param->{$key} directly
- # leads to 'undef'. I don't know why. Converting a copy works,
- # though.
- $param->{$key} = $iconv->convert("" . $param->{$key});
- } else {
- _recode_recursively($iconv, $param->{$key});
- }
- }
-
- } elsif (ref $param eq 'ARRAY') {
- foreach my $idx (0 .. scalar(@{ $param }) - 1) {
- if (!ref $param->[$idx]) {
- # Workaround for a bug: converting $param->[$idx] directly
- # leads to 'undef'. I don't know why. Converting a copy works,
- # though.
- $param->[$idx] = $iconv->convert("" . $param->[$idx]);
- } else {
- _recode_recursively($iconv, $param->[$idx]);
- }
- }
- }
- $main::lxdebug->leave_sub();
-}
-
sub new {
$main::lxdebug->enter_sub();
bless $self, $type;
- $main::lxdebug->leave_sub();
-
- return $self;
-}
-
-sub read_cgi_input {
- $main::lxdebug->enter_sub();
-
- my ($self) = @_;
-
- $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
- $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0];
-
- my $uploads;
- if ($ENV{CONTENT_LENGTH}) {
- my $content;
- read STDIN, $content, $ENV{CONTENT_LENGTH};
- $uploads = $self->_request_to_hash($content);
- }
-
- if ($self->{RESTORE_FORM_FROM_SESSION_ID}) {
- my %temp_form;
- $::auth->restore_form_from_session(delete $self->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
- $self->_input_to_hash(join '&', map { $self->escape($_) . '=' . $self->escape($temp_form{$_}) } keys %temp_form);
- }
-
- my $db_charset = $::lx_office_conf{system}->{dbcharset};
- $db_charset ||= Common::DEFAULT_CHARSET;
-
- my $encoding = $self->{INPUT_ENCODING} || $db_charset;
- delete $self->{INPUT_ENCODING};
-
- _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
-
- map { $self->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads;
-
- #$self->{version} = "2.6.1"; # Old hardcoded but secure style
open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file
$self->{version} = <VERSION_FILE>;
close VERSION_FILE;
return $self;
}
+sub read_cgi_input {
+ my ($self) = @_;
+ SL::Request::read_cgi_input($self);
+}
+
sub _flatten_variables_rec {
$main::lxdebug->enter_sub(2);
}
sub escape {
- $main::lxdebug->enter_sub(2);
-
my ($self, $str) = @_;
- $str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
- $str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge;
-
- $main::lxdebug->leave_sub(2);
-
- return $str;
+ return uri_encode($str);
}
sub unescape {
- $main::lxdebug->enter_sub(2);
-
my ($self, $str) = @_;
- $str =~ tr/+/ /;
- $str =~ s/\\$//;
-
- $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
- $str = Encode::decode('utf-8-strict', $str) if $::locale->is_utf8;
-
- $main::lxdebug->leave_sub(2);
-
- return $str;
+ return uri_decode($str);
}
sub quote {
<script type="text/javascript">
<!--
// If JavaScript is enabled, the whole thing will be reloaded.
- // The reason is: When one changes his menu setup (HTML / XUL / CSS ...)
+ // The reason is: When one changes his menu setup (HTML / CSS ...)
// it now loads the correct code into the browser instead of do nothing.
setTimeout("top.frames.location.href='login.pl'",500);
//-->
$main::lxdebug->enter_sub();
my ($self, $myconfig) = @_;
- my $out;
+ my ($out, $out_mode);
local (*IN, *OUT);
# OUT is used for the media, screen, printer, email
# for postscript we store a copy in a temporary file
- my $fileid = time;
- my $prepend_userspath;
-
- if (!$self->{tmpfile}) {
- $self->{tmpfile} = "${fileid}.$self->{IN}";
- $prepend_userspath = 1;
- }
-
- $prepend_userspath = 1 if substr($self->{tmpfile}, 0, length $userspath) eq $userspath;
-
- $self->{tmpfile} =~ s|.*/||;
- $self->{tmpfile} =~ s/[^a-zA-Z0-9\._\ \-]//g;
- $self->{tmpfile} = "$userspath/$self->{tmpfile}" if $prepend_userspath;
+ my ($temp_fh, $suffix);
+ $suffix = $self->{IN};
+ $suffix =~ s/.*\.//;
+ ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
+ 'lx-office-printXXXXXX',
+ SUFFIX => '.' . ($suffix || 'tex'),
+ DIR => $userspath,
+ UNLINK => 1,
+ );
+ close $temp_fh;
if ($template->uses_temp_file() || $self->{media} eq 'email') {
- $out = $self->{OUT};
- $self->{OUT} = "$self->{tmpfile}";
+ $out = $self->{OUT};
+ $out_mode = $self->{OUT_MODE} || '>';
+ $self->{OUT} = "$self->{tmpfile}";
+ $self->{OUT_MODE} = '>';
}
my $result;
+ my $command_formatter = sub {
+ my ($out_mode, $out) = @_;
+ return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
+ };
if ($self->{OUT}) {
- open(OUT, ">", $self->{OUT}) or $self->error("$self->{OUT} : $!");
+ $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+ open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
} else {
*OUT = ($::dispatcher->get_standard_filehandles)[1];
$self->header;
$mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
$mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
$mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
- $mail->{fileid} = "$fileid.";
+ $mail->{fileid} = time() . '.' . $$ . '.';
$myconfig->{signature} =~ s/\r//g;
# if we send html or plain text inline
if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
- $mail->{contenttype} = "text/html";
-
- $mail->{message} =~ s/\r//g;
- $mail->{message} =~ s/\n/<br>\n/g;
- $myconfig->{signature} =~ s/\n/<br>\n/g;
- $mail->{message} .= "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
+ $mail->{contenttype} = "text/html";
+ $mail->{message} =~ s/\r//g;
+ $mail->{message} =~ s/\n/<br>\n/g;
+ $myconfig->{signature} =~ s/\n/<br>\n/g;
+ $mail->{message} .= "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
open(IN, "<", $self->{tmpfile})
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
- while (<IN>) {
- $mail->{message} .= $_;
- }
-
+ $mail->{message} .= $_ while <IN>;
close(IN);
} else {
} else {
- $self->{OUT} = $out;
+ $self->{OUT} = $out;
+ $self->{OUT_MODE} = $out_mode;
my $numbytes = (-s $self->{tmpfile});
open(IN, "<", $self->{tmpfile})
#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} : $!");
+ $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+
+ open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
print OUT $_ while <IN>;
close OUT;
- seek IN, 0, 0;
+ seek IN, 0, 0;
} else {
$self->{attachment_filename} = ($self->{attachment_filename})
$formname ||= $self->{formname};
+ $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
+ my $recipient_locale = Locale->new($self->{recipient_locale});
+
my %formname_translations = (
- bin_list => $main::locale->text('Bin List'),
- credit_note => $main::locale->text('Credit Note'),
- invoice => $main::locale->text('Invoice'),
- pick_list => $main::locale->text('Pick List'),
- proforma => $main::locale->text('Proforma Invoice'),
- purchase_order => $main::locale->text('Purchase Order'),
- request_quotation => $main::locale->text('RFQ'),
- sales_order => $main::locale->text('Confirmation'),
- sales_quotation => $main::locale->text('Quotation'),
- storno_invoice => $main::locale->text('Storno Invoice'),
- sales_delivery_order => $main::locale->text('Delivery Order'),
- purchase_delivery_order => $main::locale->text('Delivery Order'),
- dunning => $main::locale->text('Dunning'),
+ bin_list => $recipient_locale->text('Bin List'),
+ credit_note => $recipient_locale->text('Credit Note'),
+ invoice => $recipient_locale->text('Invoice'),
+ pick_list => $recipient_locale->text('Pick List'),
+ proforma => $recipient_locale->text('Proforma Invoice'),
+ purchase_order => $recipient_locale->text('Purchase Order'),
+ request_quotation => $recipient_locale->text('RFQ'),
+ sales_order => $recipient_locale->text('Confirmation'),
+ sales_quotation => $recipient_locale->text('Quotation'),
+ storno_invoice => $recipient_locale->text('Storno Invoice'),
+ sales_delivery_order => $recipient_locale->text('Delivery Order'),
+ purchase_delivery_order => $recipient_locale->text('Delivery Order'),
+ dunning => $recipient_locale->text('Dunning'),
);
$main::lxdebug->leave_sub();
- return $formname_translations{$formname}
+ return $formname_translations{$formname};
}
sub get_number_prefix_for_type {
$main::lxdebug->enter_sub();
my ($self) = @_;
+ $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
+ my $recipient_locale = Locale->new($self->{recipient_locale});
+
my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();
if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
- $attachment_filename .= ' (' . $main::locale->text('Preview') . ')' . $self->get_extension_for_format();
+ $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
} elsif ($attachment_filename && $self->{"${prefix}number"}) {
$attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
return scalar(@{ $self->{name_list} });
}
-# the selection sub is used in the AR, AP, IS, IR and OE module
+# the selection sub is used in the AR, AP, IS, IR, DO and OE module
#
sub all_vc {
$main::lxdebug->enter_sub();
$table = $table eq "customer" ? "customer" : "vendor";
- my $query = qq|SELECT count(*) FROM $table|;
+ my $query = qq|SELECT count(*) FROM $table WHERE NOT obsolete|;
my ($count) = selectrow_query($self, $dbh, $query);
# build selection list
if ($self->{"$self->{vc}_id"}) {
# only setup currency
- ($self->{currency}) = split(/:/, $self->{currencies});
+ ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency};
} else {
"a.department_id" => "department_id",
"d.description" => "department",
"ct.name" => $table,
+ "ct.curr" => "cv_curr",
"current_date + ct.terms" => "duedate",
);
if ($self->{type} =~ /delivery_order/) {
$arap = 'delivery_orders';
delete $column_map{"a.curr"};
+ delete $column_map{"ct.curr"};
} elsif ($self->{type} =~ /_order/) {
$arap = 'oe';
# remove any trailing whitespace
$self->{currency} =~ s/\s*$// if $self->{currency};
+ $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr};
+
+ # if customer/vendor currency is set use this
+ $self->{currency} = $self->{cv_curr} if $self->{cv_curr};
$main::lxdebug->leave_sub();
}
=head1 SPECIAL FUNCTIONS
-=head2 C<_store_value()>
-
-parses a complex var name, and stores it in the form.
-
-syntax:
- $form->_store_value($key, $value);
-
-keys must start with a string, and can contain various tokens.
-supported key structures are:
-
-1. simple access
- simple key strings work as expected
-
- id => $form->{id}
-
-2. hash access.
- separating two keys by a dot (.) will result in a hash lookup for the inner value
- this is similar to the behaviour of java and templating mechanisms.
-
- filter.description => $form->{filter}->{description}
-
-3. array+hashref access
-
- adding brackets ([]) before the dot will cause the next hash to be put into an array.
- using [+] instead of [] will force a new array index. this is useful for recurring
- data structures like part lists. put a [+] into the first varname, and use [] on the
- following ones.
-
- repeating these names in your template:
-
- invoice.items[+].id
- invoice.items[].parts_id
-
- will result in:
-
- $form->{invoice}->{items}->[
- {
- id => ...
- parts_id => ...
- },
- {
- id => ...
- parts_id => ...
- }
- ...
- ]
-
-4. arrays
-
- using brackets at the end of a name will result in a pure array to be created.
- note that you mustn't use [+], which is reserved for array+hash access and will
- result in undefined behaviour in array context.
-
- filter.status[] => $form->{status}->[ val1, val2, ... ]
-
=head2 C<update_business> PARAMS
PARAMS (not named):
projects / kivitendo-erp.git / blobdiff