Revision cc042e07
Von Sven Schöling vor mehr als 14 Jahren hinzugefügt
| SL/Locale.pm | ||
|---|---|---|
| 36 | 36 |
|
| 37 | 37 |
package Locale; |
| 38 | 38 |
|
| 39 |
use Text::Iconv;
|
|
| 39 |
use Encode;
|
|
| 40 | 40 |
use List::Util qw(first); |
| 41 |
use List::MoreUtils qw(any); |
|
| 41 | 42 |
|
| 42 | 43 |
use SL::LXDebug; |
| 43 | 44 |
use SL::Common; |
| 45 |
use SL::Iconv; |
|
| 44 | 46 |
use SL::Inifile; |
| 45 | 47 |
|
| 46 | 48 |
use strict; |
| ... | ... | |
| 88 | 90 |
} |
| 89 | 91 |
|
| 90 | 92 |
my $db_charset = $main::dbcharset || Common::DEFAULT_CHARSET; |
| 93 |
$self->{is_utf8} = (any { lc($::dbcharset || '') eq $_ } qw(utf8 utf-8 unicode)) ? 1 : 0;
|
|
| 91 | 94 |
|
| 92 |
$self->{iconv} = Text::Iconv->new($self->{charset}, $db_charset);
|
|
| 93 |
$self->{iconv_reverse} = Text::Iconv->new($db_charset, $self->{charset});
|
|
| 94 |
$self->{iconv_english} = Text::Iconv->new('ASCII', $db_charset);
|
|
| 95 |
$self->{iconv_iso8859} = Text::Iconv->new('ISO-8859-15', $db_charset);
|
|
| 96 |
$self->{iconv_to_iso8859} = Text::Iconv->new($db_charset, 'ISO-8859-15');
|
|
| 95 |
if ($self->{is_utf8}) {
|
|
| 96 |
binmode STDOUT, ":utf8"; |
|
| 97 |
binmode STDERR, ":utf8"; |
|
| 98 |
} |
|
| 99 |
|
|
| 100 |
$self->{iconv} = SL::Iconv->new($self->{charset}, $db_charset);
|
|
| 101 |
$self->{iconv_reverse} = SL::Iconv->new($db_charset, $self->{charset});
|
|
| 102 |
$self->{iconv_english} = SL::Iconv->new('ASCII', $db_charset);
|
|
| 103 |
$self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', $db_charset);
|
|
| 104 |
$self->{iconv_to_iso8859} = SL::Iconv->new($db_charset, 'ISO-8859-15');
|
|
| 97 | 105 |
|
| 98 | 106 |
$self->_read_special_chars_file($country); |
| 99 | 107 |
|
| ... | ... | |
| 105 | 113 |
(qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)); |
| 106 | 114 |
} |
| 107 | 115 |
|
| 116 |
sub is_utf8 {
|
|
| 117 |
my $self = shift; |
|
| 118 |
my $handle = shift; |
|
| 119 |
return $self->{is_utf8} && (!$handle || $handle->is_utf8);
|
|
| 120 |
} |
|
| 121 |
|
|
| 108 | 122 |
sub _handle_markup {
|
| 109 | 123 |
my $self = shift; |
| 110 | 124 |
my $str = shift; |
| ... | ... | |
| 406 | 420 |
return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
|
| 407 | 421 |
} |
| 408 | 422 |
|
| 423 |
sub with_raw_io {
|
|
| 424 |
my $self = shift; |
|
| 425 |
my $fh = shift; |
|
| 426 |
my $code = shift; |
|
| 427 |
|
|
| 428 |
binmode $fh, ":raw"; |
|
| 429 |
$code->(); |
|
| 430 |
binmode $fh, ":utf8" if $self->is_utf8; |
|
| 431 |
} |
|
| 432 |
|
|
| 409 | 433 |
1; |
| SL/ReportGenerator.pm | ||
|---|---|---|
| 1 | 1 |
package SL::ReportGenerator; |
| 2 | 2 |
|
| 3 | 3 |
use Data::Dumper; |
| 4 |
use Encode; |
|
| 5 | 4 |
use IO::Wrap; |
| 6 | 5 |
use List::Util qw(max); |
| 7 | 6 |
use Text::CSV_XS; |
| 8 |
use Text::Iconv; |
|
| 9 | 7 |
#use PDF::API2; # these two eat up to .75s on startup. only load them if we actually need them |
| 10 | 8 |
#use PDF::Table; |
| 11 | 9 |
|
| ... | ... | |
| 235 | 233 |
my $filename = $self->get_attachment_basename(); |
| 236 | 234 |
print qq|content-type: text/csv\n|; |
| 237 | 235 |
print qq|content-disposition: attachment; filename=${filename}.csv\n\n|;
|
| 238 |
$self->generate_csv_content(); |
|
| 236 |
$::locale->with_raw_io(\*STDOUT, sub {
|
|
| 237 |
$self->generate_csv_content(); |
|
| 238 |
}); |
|
| 239 | 239 |
|
| 240 | 240 |
} elsif ($format eq 'pdf') {
|
| 241 | 241 |
$self->generate_pdf_content(); |
| ... | ... | |
| 410 | 410 |
return $_[0] * 72 / 2.54; |
| 411 | 411 |
} |
| 412 | 412 |
|
| 413 |
sub _decode_text {
|
|
| 414 |
my $self = shift; |
|
| 415 |
my $text = shift; |
|
| 416 |
|
|
| 417 |
$text = decode('UTF-8', $text) if ($self->{text_is_utf8});
|
|
| 418 |
|
|
| 419 |
return $text; |
|
| 420 |
} |
|
| 421 |
|
|
| 422 | 413 |
sub generate_pdf_content {
|
| 423 | 414 |
eval {
|
| 424 | 415 |
require PDF::API2; |
| ... | ... | |
| 440 | 431 |
my $num_columns = scalar @visible_columns; |
| 441 | 432 |
my $num_header_rows = 1; |
| 442 | 433 |
|
| 443 |
my $font_encoding = $main::dbcharset || 'ISO-8859-15'; |
|
| 444 |
$self->{text_is_utf8} = $font_encoding =~ m/^utf-?8$/i;
|
|
| 434 |
my $font_encoding = $main::dbcharset || 'ISO-8859-15'; |
|
| 445 | 435 |
|
| 446 | 436 |
foreach my $name (@visible_columns) {
|
| 447 | 437 |
push @column_props, { 'justify' => $self->{columns}->{$name}->{align} eq 'right' ? 'right' : 'left' };
|
| ... | ... | |
| 456 | 446 |
foreach my $name (@visible_columns) {
|
| 457 | 447 |
my $column = $self->{columns}->{$name};
|
| 458 | 448 |
|
| 459 |
push @{ $data_row }, $self->_decode_text($column->{text});
|
|
| 449 |
push @{ $data_row }, $column->{text};
|
|
| 460 | 450 |
push @{ $cell_props_row }, {};
|
| 461 | 451 |
} |
| 462 | 452 |
|
| ... | ... | |
| 470 | 460 |
push @cell_props, $cell_props_row; |
| 471 | 461 |
|
| 472 | 462 |
foreach my $custom_header_col (@{ $custom_header_row }) {
|
| 473 |
push @{ $data_row }, $self->_decode_text($custom_header_col->{text});
|
|
| 463 |
push @{ $data_row }, $custom_header_col->{text};
|
|
| 474 | 464 |
|
| 475 | 465 |
my $num_output = ($custom_header_col->{colspan} * 1 > 1) ? $custom_header_col->{colspan} : 1;
|
| 476 | 466 |
if ($num_output > 1) {
|
| ... | ... | |
| 488 | 478 |
foreach my $row_set (@{ $self->{data} }) {
|
| 489 | 479 |
if ('HASH' eq ref $row_set) {
|
| 490 | 480 |
if ($row_set->{type} eq 'colspan_data') {
|
| 491 |
push @data, [ $self->_decode_text($row_set->{data}) ];
|
|
| 481 |
push @data, [ $row_set->{data} ];
|
|
| 492 | 482 |
|
| 493 | 483 |
$cell_props_row = []; |
| 494 | 484 |
push @cell_props, $cell_props_row; |
| ... | ... | |
| 512 | 502 |
my $col_idx = 0; |
| 513 | 503 |
foreach my $col_name (@visible_columns) {
|
| 514 | 504 |
my $col = $row->{$col_name};
|
| 515 |
push @{ $data_row }, $self->_decode_text(join("\n", @{ $col->{data} || [] }));
|
|
| 505 |
push @{ $data_row }, join("\n", @{ $col->{data} || [] });
|
|
| 516 | 506 |
|
| 517 | 507 |
$column_props[$col_idx]->{justify} = 'right' if ($col->{align} eq 'right');
|
| 518 | 508 |
|
| ... | ... | |
| 583 | 573 |
my $top_text_height = 0; |
| 584 | 574 |
|
| 585 | 575 |
if ($self->{options}->{top_info_text}) {
|
| 586 |
my $top_text = $self->_decode_text($self->{options}->{top_info_text});
|
|
| 576 |
my $top_text = $self->{options}->{top_info_text};
|
|
| 587 | 577 |
$top_text =~ s/\r//g; |
| 588 | 578 |
$top_text =~ s/\n+$//; |
| 589 | 579 |
|
| ... | ... | |
| 631 | 621 |
my $curpage = $pdf->openpage($page_num); |
| 632 | 622 |
|
| 633 | 623 |
if ($pdfopts->{number}) {
|
| 634 |
my $label = $self->_decode_text($main::locale->text("Page #1/#2", $page_num, $pdf->pages()));
|
|
| 624 |
my $label = $main::locale->text("Page #1/#2", $page_num, $pdf->pages());
|
|
| 635 | 625 |
my $text_obj = $curpage->text(); |
| 636 | 626 |
|
| 637 | 627 |
$text_obj->font($font, $font_size); |
| ... | ... | |
| 640 | 630 |
} |
| 641 | 631 |
|
| 642 | 632 |
if ($opts->{title}) {
|
| 643 |
my $title = $self->_decode_text($opts->{title});
|
|
| 633 |
my $title = $opts->{title};
|
|
| 644 | 634 |
my $text_obj = $curpage->text(); |
| 645 | 635 |
|
| 646 | 636 |
$text_obj->font($font, $title_font_size); |
| ... | ... | |
| 671 | 661 |
print qq|content-type: application/pdf\n|; |
| 672 | 662 |
print qq|content-disposition: attachment; filename=${filename}.pdf\n\n|;
|
| 673 | 663 |
|
| 674 |
print $content; |
|
| 664 |
$::locale->with_raw_io(\*STDOUT, sub {
|
|
| 665 |
print $content; |
|
| 666 |
}); |
|
| 675 | 667 |
} |
| 676 | 668 |
} |
| 677 | 669 |
|
| ... | ... | |
| 700 | 692 |
sub unescape_string {
|
| 701 | 693 |
my $self = shift; |
| 702 | 694 |
my $text = shift; |
| 703 |
my $iconv = $main::locale->{iconv};
|
|
| 704 | 695 |
|
| 705 | 696 |
$text = $main::locale->unquote_special_chars('HTML', $text);
|
| 706 |
$text = $main::locale->{iconv}->convert($text) if ($main::locale->{iconv});
|
|
| 697 |
$text = $::locale->{iconv}->convert($text);
|
|
| 707 | 698 |
|
| 708 | 699 |
return $text; |
| 709 | 700 |
} |
| SL/SEPA/XML.pm | ||
|---|---|---|
| 8 | 8 |
use List::Util qw(first sum); |
| 9 | 9 |
use List::MoreUtils qw(any); |
| 10 | 10 |
use POSIX qw(strftime); |
| 11 |
use Text::Iconv; |
|
| 12 | 11 |
use XML::Writer; |
| 13 | 12 |
|
| 13 |
use SL::Iconv; |
|
| 14 | 14 |
use SL::SEPA::XML::Transaction; |
| 15 | 15 |
|
| 16 | 16 |
sub new {
|
| ... | ... | |
| 34 | 34 |
|
| 35 | 35 |
map { $self->{$_} = $params{$_} if (exists $params{$_}) } qw(src_charset company message_id grouped);
|
| 36 | 36 |
|
| 37 |
$self->{iconv} = Text::Iconv->new($self->{src_charset}, "UTF-8") || croak "Unsupported source charset $self->{src_charset}.";
|
|
| 37 |
$self->{iconv} = SL::Iconv->new($self->{src_charset}, "UTF-8") || croak "Unsupported source charset $self->{src_charset}.";
|
|
| 38 | 38 |
|
| 39 | 39 |
my $missing_parameter = first { !$self->{$_} } qw(company message_id);
|
| 40 | 40 |
croak "Missing parameter: $missing_parameter" if ($missing_parameter); |
| 41 | 41 |
|
| 42 |
map { $self->{$_} = $self->_replace_special_chars(decode('UTF-8', $self->{iconv}->convert($self->{$_}))) } qw(company message_id);
|
|
| 42 |
map { $self->{$_} = $self->_replace_special_chars($self->{iconv}->convert($self->{$_})) } qw(company message_id);
|
|
| 43 | 43 |
} |
| 44 | 44 |
|
| 45 | 45 |
sub add_transaction {
|
| SL/SEPA/XML/Transaction.pm | ||
|---|---|---|
| 6 | 6 |
use Encode; |
| 7 | 7 |
use List::Util qw(first); |
| 8 | 8 |
use POSIX qw(strftime); |
| 9 |
use Text::Iconv; |
|
| 10 | 9 |
|
| 11 | 10 |
sub new {
|
| 12 | 11 |
my $class = shift; |
| ... | ... | |
| 34 | 33 |
|
| 35 | 34 |
croak "Execution date format wrong for '$params{execution_date}': not YYYY-MM-DD." if ($params{execution_date} !~ /^\d{4}-\d{2}-\d{2}$/);
|
| 36 | 35 |
|
| 37 |
map { $self->{$_} = decode('UTF-8', $self->{sepa}->{iconv}->convert($params{$_})) } keys %params;
|
|
| 38 |
map { $self->{$_} =~ s/\s+//g } qw(src_iban src_bic dst_iban dst_bic);
|
|
| 39 |
map { $self->{$_} = $self->{sepa}->_replace_special_chars($self->{$_}) } qw(recipient reference end_to_end_id);
|
|
| 36 |
map { $self->{$_} = $self->{sepa}->{iconv}->convert($params{$_}) } keys %params;
|
|
| 37 |
map { $self->{$_} =~ s/\s+//g } qw(src_iban src_bic dst_iban dst_bic);
|
|
| 38 |
map { $self->{$_} = $self->{sepa}->_replace_special_chars($self->{$_}) } qw(recipient reference end_to_end_id);
|
|
| 40 | 39 |
} |
| 41 | 40 |
|
| 42 | 41 |
sub get {
|
| SL/Template.pm | ||
|---|---|---|
| 838 | 838 |
|
| 839 | 839 |
package OpenDocumentTemplate; |
| 840 | 840 |
|
| 841 |
use Archive::Zip; |
|
| 841 | 842 |
use POSIX 'setsid'; |
| 842 | 843 |
use vars qw(@ISA); |
| 843 | 844 |
|
| 845 |
use SL::Iconv; |
|
| 846 |
|
|
| 844 | 847 |
use Cwd; |
| 845 | 848 |
# use File::Copy; |
| 846 | 849 |
# use File::Spec; |
| ... | ... | |
| 856 | 859 |
|
| 857 | 860 |
my $self = $type->SUPER::new(@_); |
| 858 | 861 |
|
| 859 |
foreach my $module (qw(Archive::Zip Text::Iconv)) {
|
|
| 860 |
eval("use ${module};");
|
|
| 861 |
if ($@) {
|
|
| 862 |
$self->{"form"}->error("The Perl module '${module}' could not be " .
|
|
| 863 |
"loaded. Support for OpenDocument templates " . |
|
| 864 |
"does not work without it. Please install your " . |
|
| 865 |
"distribution's package or get the module from " . |
|
| 866 |
"CPAN ( http://www.cpan.org )."); |
|
| 867 |
} |
|
| 868 |
} |
|
| 869 |
|
|
| 870 | 862 |
$self->{"rnd"} = int(rand(1000000));
|
| 871 |
$self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
|
|
| 863 |
$self->{"iconv"} = SL::Iconv->new($main::dbcharset, "UTF-8");
|
|
| 872 | 864 |
|
| 873 | 865 |
$self->set_tag_style('<%', '%>');
|
| 874 | 866 |
$self->{quot_re} = '"';
|
Auch abrufbar als: Unified diff
UTF8-Flags setzen/beachten
Conflicts: