X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=bdb9036d2bed8acccac8e6f15dab33b2c8cd3924;hb=26353951881b5334436ab599ae3979f6df5d5258;hp=fad6e8ea68504755175478f06cb7c457832ba5d3;hpb=97c8f14b3fea88e6b482919d944cb8e6461bc451;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index fad6e8ea6..bdb9036d2 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -42,6 +42,7 @@ use Data::Dumper;
use CGI;
use CGI::Ajax;
use Cwd;
+use Encode;
use IO::File;
use SL::Auth;
use SL::Auth::DB;
@@ -56,7 +57,7 @@ use SL::User;
use Template;
use URI;
use List::Util qw(first max min sum);
-use List::MoreUtils qw(any);
+use List::MoreUtils qw(any apply);
use strict;
@@ -379,6 +380,7 @@ sub escape {
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);
@@ -614,121 +616,72 @@ sub create_http_response {
sub header {
- $main::lxdebug->enter_sub();
+ $::lxdebug->enter_sub;
- # extra code ist currently only used by menuv3 and menuv4 to set their css.
+ # extra code is currently only used by menuv3 and menuv4 to set their css.
# it is strongly deprecated, and will be changed in a future version.
my ($self, $extra_code) = @_;
+ my $db_charset = $::dbcharset || Common::DEFAULT_CHARSET;
+ my @header;
+
+ $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
+
+ $self->{favicon} ||= "favicon.ico";
+ $self->{titlebar} = "$self->{title} - $self->{titlebar}" if $self->{title};
+
+ # build includes
+ if ($self->{refresh_url} || $self->{refresh_time}) {
+ my $refresh_time = $self->{refresh_time} || 3;
+ my $refresh_url = $self->{refresh_url} || $ENV{REFERER};
+ push @header, "";
+ }
+
+ push @header, ""
+ for grep { -f "css/$_" } apply { s|.*/|| } $self->{stylesheet}, $self->{stylesheets};
+
+ push @header, "" if $self->{landscape};
+ push @header, "" if -f $self->{favicon};
+ push @header, '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '';
+ push @header, $self->{javascript} if $self->{javascript};
+ push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
+ push @header, "" if $self->{fokus};
+ push @header, sprintf "",
+ join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title};
- if ($self->{header}) {
- $main::lxdebug->leave_sub();
- return;
- }
-
- my ($stylesheet, $favicon, $pagelayout);
-
- if ($ENV{HTTP_USER_AGENT}) {
- my $doctype;
-
- if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) {
- # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise.
- $doctype = qq|\n|;
- }
-
- my $stylesheets = "$self->{stylesheet} $self->{stylesheets}";
-
- $stylesheets =~ s|^\s*||;
- $stylesheets =~ s|\s*$||;
- foreach my $file (split m/\s+/, $stylesheets) {
- $file =~ s|.*/||;
- next if (! -f "css/$file");
-
- $stylesheet .= qq|\n|;
- }
-
- $self->{favicon} = "favicon.ico" unless $self->{favicon};
-
- if ($self->{favicon} && (-f "$self->{favicon}")) {
- $favicon =
- qq|
- |;
- }
-
- my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
-
- if ($self->{landscape}) {
- $pagelayout = qq||;
- }
-
- my $fokus = qq|
+ # if there is a title, we put some JavaScript in to the page, wich writes a
+ # meaningful title-tag for our frameset.
+ my $title_hack = '';
+ if ($self->{title}) {
+ $title_hack = qq|
- | if $self->{"fokus"};
-
- # if there is a title, we put some JavaScript in to the page, wich writes a
- # meaningful title-tag for our frameset.
- my $title_hack;
- if ($self->{"title"}){
- $title_hack = qq|
-
- |;
- }
-
- #Set Calendar
- my $jsscript = "";
- if ($self->{jsscript} == 1) {
-
- $jsscript = qq|
-
-
-
-
-
-
- $self->{javascript}
- |;
- }
-
- $self->{titlebar} =
- ($self->{title})
- ? "$self->{title} - $self->{titlebar}"
- : $self->{titlebar};
- my $ajax = "";
- for my $item (@ { $self->{AJAX} || [] }) {
- $ajax .= $item->show_javascript();
- }
+ |;
+ }
- print $self->create_http_response('content_type' => 'text/html',
- 'charset' => $db_charset,);
- print qq|${doctype}
-
-
+ # output
+ print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
+ print "\n"
+ if $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/; # Other browsers may choke on menu scripts with DOCTYPE.
+ print <
+
+
$self->{titlebar}
- $stylesheet
- $pagelayout
- $favicon
- $jsscript
- $ajax
- $fokus
- $title_hack
-
+EOT
+ print " $_\n" for @header;
+ print <
-
-
-
$extra_code
-
+ $title_hack
+
-|;
- }
- $self->{header} = 1;
+EOT
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
sub ajax_response_header {
@@ -829,13 +780,13 @@ sub _prepare_html_template {
}
if (%main::myconfig) {
- map({ $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys(%main::myconfig));
- my $jsc_dateformat = $main::myconfig{"dateformat"};
- $jsc_dateformat =~ s/d+/\%d/gi;
- $jsc_dateformat =~ s/m+/\%m/gi;
- $jsc_dateformat =~ s/y+/\%Y/gi;
- $additional_params->{"myconfig_jsc_dateformat"} = $jsc_dateformat;
+ $::myconfig{jsc_dateformat} = apply {
+ s/d+/\%d/gi;
+ s/m+/\%m/gi;
+ s/y+/\%Y/gi;
+ } $::myconfig{"dateformat"};
$additional_params->{"myconfig"} ||= \%::myconfig;
+ map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
}
$additional_params->{"conf_dbcharset"} = $main::dbcharset;
@@ -1247,7 +1198,7 @@ sub parse_template {
$ext_for_format = 'xml';
} elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
- $template_type = 'xml';
+ $template_type = 'XML';
} elsif ( $self->{"format"} =~ /excel/i ) {
$template_type = 'Excel';
@@ -1423,7 +1374,6 @@ sub get_formname_translation {
bin_list => $main::locale->text('Bin List'),
credit_note => $main::locale->text('Credit Note'),
invoice => $main::locale->text('Invoice'),
- packing_list => $main::locale->text('Packing List'),
pick_list => $main::locale->text('Pick List'),
proforma => $main::locale->text('Proforma Invoice'),
purchase_order => $main::locale->text('Purchase Order'),
@@ -1431,7 +1381,6 @@ sub get_formname_translation {
sales_order => $main::locale->text('Confirmation'),
sales_quotation => $main::locale->text('Quotation'),
storno_invoice => $main::locale->text('Storno Invoice'),
- storno_packing_list => $main::locale->text('Storno Packing List'),
sales_delivery_order => $main::locale->text('Delivery Order'),
purchase_delivery_order => $main::locale->text('Delivery Order'),
dunning => $main::locale->text('Dunning'),
@@ -2019,7 +1968,7 @@ sub add_shipto {
my @values;
foreach my $item (qw(name department_1 department_2 street zipcode city country
- contact phone fax email)) {
+ contact cp_gender phone fax email)) {
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
@@ -2037,6 +1986,7 @@ sub add_shipto {
shiptocity = ?,
shiptocountry = ?,
shiptocontact = ?,
+ shiptocp_gender = ?,
shiptophone = ?,
shiptofax = ?,
shiptoemail = ?
@@ -2052,6 +2002,7 @@ sub add_shipto {
shiptocity = ? AND
shiptocountry = ? AND
shiptocontact = ? AND
+ shiptocp_gender = ? AND
shiptophone = ? AND
shiptofax = ? AND
shiptoemail = ? AND
@@ -2062,8 +2013,8 @@ sub add_shipto {
$query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
shiptostreet, shiptozipcode, shiptocity, shiptocountry,
- shiptocontact, shiptophone, shiptofax, shiptoemail, module)
- VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
+ shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
+ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $id, @values, $module);
}
}
@@ -3272,7 +3223,6 @@ sub save_status {
# $main::locale->text('invoice')
# $main::locale->text('proforma')
# $main::locale->text('sales_order')
-# $main::locale->text('packing_list')
# $main::locale->text('pick_list')
# $main::locale->text('purchase_order')
# $main::locale->text('bin_list')
@@ -3565,9 +3515,7 @@ Points of interest for a beginner are:
=head1 SPECIAL FUNCTIONS
-=over 4
-
-=item _store_value()
+=head2 C<_store_value()>
parses a complex var name, and stores it in the form.
@@ -3622,7 +3570,7 @@ supported key structures are:
filter.status[] => $form->{status}->[ val1, val2, ... ]
-=item update_business PARAMS
+=head2 C PARAMS
PARAMS (not named):
\%config, - config hashref
@@ -3634,7 +3582,7 @@ handles business (thats customer/vendor types) sequences.
special behaviour for empty strings in customerinitnumber field:
will in this case not increase the value, and return undef.
-=item redirect_header $url
+=head2 C $url
Generates a HTTP redirection header for the new C<$url>. Constructs an
absolute URL including scheme, host name and port. If C<$url> is a
@@ -3648,6 +3596,45 @@ Examples:
print $::form->redirect_header('oe.pl?action=edit&id=1234');
print $::form->redirect_header('http://www.lx-office.org/');
+=head2 C
+
+Generates a general purpose http/html header and includes most of the scripts
+ans stylesheets needed.
+
+Only one header will be generated. If the method was already called in this
+request it will not output anything and return undef. Also if no
+HTTP_USER_AGENT is found, no header is generated.
+
+Although header does not accept parameters itself, it will honor special
+hashkeys of its Form instance:
+
+=over 4
+
+=item refresh_time
+
+=item refresh_url
+
+If one of these is set, a http-equiv refresh is generated. Missing parameters
+default to 3 seconds and the refering url.
+
+=item stylesheet
+
+=item stylesheets
+
+If these are arrayrefs the contents will be inlined into the header.
+
+=item landscape
+
+If true, a css snippet will be generated that sets the page in landscape mode.
+
+=item favicon
+
+Used to override the default favicon.
+
+=item title
+
+A html page title will be generated from this
+
=back
=cut