Revision fec48603
Von Jan Büren vor mehr als 7 Jahren hinzugefügt
| SL/DB/Helper/ReplaceSpecialChars.pm | ||
|---|---|---|
| 1 |
package SL::DB::Helper::ReplaceSpecialChars; |
|
| 2 |
|
|
| 3 |
use strict; |
|
| 4 |
use utf8; |
|
| 5 |
|
|
| 6 |
use parent qw(Exporter); |
|
| 7 |
our @EXPORT = qw(replace_special_chars); |
|
| 8 |
|
|
| 9 |
use Carp; |
|
| 10 |
use Text::Unidecode qw(unidecode); |
|
| 11 |
|
|
| 12 |
|
|
| 13 |
|
|
| 14 |
|
|
| 15 |
sub replace_special_chars {
|
|
| 16 |
my $text = shift; |
|
| 17 |
|
|
| 18 |
return unless $text; |
|
| 19 |
|
|
| 20 |
my %special_chars = ( |
|
| 21 |
'ä' => 'ae', |
|
| 22 |
'ö' => 'oe', |
|
| 23 |
'ü' => 'ue', |
|
| 24 |
'Ä' => 'Ae', |
|
| 25 |
'Ö' => 'Oe', |
|
| 26 |
'Ü' => 'Ue', |
|
| 27 |
'ß' => 'ss', |
|
| 28 |
'&' => '+', |
|
| 29 |
'`' => '\'', |
|
| 30 |
); |
|
| 31 |
|
|
| 32 |
map { $text =~ s/$_/$special_chars{$_}/g; } keys %special_chars;
|
|
| 33 |
|
|
| 34 |
# for all other non ascii chars 'OLÉ S.L.' and 'Årdberg AB'! |
|
| 35 |
$text = unidecode($text); |
|
| 36 |
|
|
| 37 |
return $text; |
|
| 38 |
} |
|
| 39 |
|
|
| 40 |
1; |
|
| 41 |
__END__ |
|
| 42 |
|
|
| 43 |
=pod |
|
| 44 |
|
|
| 45 |
=encoding utf8 |
|
| 46 |
|
|
| 47 |
=head1 NAME |
|
| 48 |
|
|
| 49 |
SL::DB::Helper::ReplaceSpecialChars - Helper functions for replacing non-ascii characaters |
|
| 50 |
|
|
| 51 |
=head1 SYNOPSIS |
|
| 52 |
|
|
| 53 |
use SL::DB::Helper::ReplaceSpecialChars qw(replace_special_chars); |
|
| 54 |
my $ansi_string = replace_special_chars("Überhaupt, with Olé \x{5317}\x{4EB0}"); # hint perldoc may already convert
|
|
| 55 |
print $ansi_string; |
|
| 56 |
# Ueberhaupt, with Ole Bei Jing |
|
| 57 |
|
|
| 58 |
=head1 FUNCTIONS |
|
| 59 |
|
|
| 60 |
=over 4 |
|
| 61 |
|
|
| 62 |
=item C<replace_special_chars $text> |
|
| 63 |
|
|
| 64 |
Given a text string this method replaces the most common german umlaute, |
|
| 65 |
transforms '&' to '+' and escapes a single quote (').
|
|
| 66 |
If there are still some non-ascii chars, we use unidecode to guess |
|
| 67 |
a sensible ascii presentation, C<perldoc Text::Unidecode> |
|
| 68 |
|
|
| 69 |
=back |
|
| 70 |
|
|
| 71 |
=head1 BUGS |
|
| 72 |
|
|
| 73 |
Nothing here yet. |
|
| 74 |
|
|
| 75 |
=head1 AUTHOR |
|
| 76 |
|
|
| 77 |
M.Bunkus |
|
| 78 |
J.Büren (Unidecode added) |
|
| 79 |
|
|
| 80 |
=cut |
|
| 81 |
|
|
| 82 |
|
|
| SL/SEPA/XML.pm | ||
|---|---|---|
| 12 | 12 |
|
| 13 | 13 |
use SL::Iconv; |
| 14 | 14 |
use SL::SEPA::XML::Transaction; |
| 15 |
use SL::DB::Helper::ReplaceSpecialChars qw(replace_special_chars); |
|
| 15 | 16 |
|
| 16 | 17 |
sub new {
|
| 17 | 18 |
my $class = shift; |
| ... | ... | |
| 40 | 41 |
croak "Missing parameter: $missing_parameter" if ($missing_parameter); |
| 41 | 42 |
croak "Missing parameter: creditor_id" if !$self->{creditor_id} && $self->{collection};
|
| 42 | 43 |
|
| 43 |
map { $self->{$_} = $self->_replace_special_chars($self->{iconv}->convert($self->{$_})) } qw(company message_id creditor_id);
|
|
| 44 |
map { $self->{$_} = replace_special_chars($self->{iconv}->convert($self->{$_})) } qw(company message_id creditor_id);
|
|
| 44 | 45 |
} |
| 45 | 46 |
|
| 46 | 47 |
sub add_transaction {
|
| ... | ... | |
| 54 | 55 |
return 1; |
| 55 | 56 |
} |
| 56 | 57 |
|
| 57 |
sub _replace_special_chars {
|
|
| 58 |
my $self = shift; |
|
| 59 |
my $text = shift; |
|
| 60 |
|
|
| 61 |
my %special_chars = ( |
|
| 62 |
'ä' => 'ae', |
|
| 63 |
'ö' => 'oe', |
|
| 64 |
'ü' => 'ue', |
|
| 65 |
'Ä' => 'Ae', |
|
| 66 |
'Ö' => 'Oe', |
|
| 67 |
'Ü' => 'Ue', |
|
| 68 |
'ß' => 'ss', |
|
| 69 |
'&' => '+', |
|
| 70 |
'`' => '\'', |
|
| 71 |
); |
|
| 72 |
|
|
| 73 |
map { $text =~ s/$_/$special_chars{$_}/g; } keys %special_chars;
|
|
| 74 |
|
|
| 75 |
# for all other non ascii chars 'OLÉ S.L.' and 'Årdberg AB'! |
|
| 76 |
use Text::Unidecode qw(unidecode); |
|
| 77 |
$text = unidecode($text); |
|
| 78 |
|
|
| 79 |
return $text; |
|
| 80 |
} |
|
| 81 |
|
|
| 82 | 58 |
sub _format_amount {
|
| 83 | 59 |
my $self = shift; |
| 84 | 60 |
my $amount = shift; |
| SL/SEPA/XML/Transaction.pm | ||
|---|---|---|
| 2 | 2 |
|
| 3 | 3 |
use strict; |
| 4 | 4 |
|
| 5 |
use SL::DB::Helper::ReplaceSpecialChars qw(replace_special_chars); |
|
| 6 |
|
|
| 5 | 7 |
use Carp; |
| 6 | 8 |
use Encode; |
| 7 | 9 |
use List::Util qw(first); |
| ... | ... | |
| 35 | 37 |
|
| 36 | 38 |
map { $self->{$_} = $self->{sepa}->{iconv}->convert($params{$_}) } keys %params;
|
| 37 | 39 |
map { $self->{$_} =~ s/\s+//g } qw(src_iban src_bic dst_iban dst_bic);
|
| 38 |
map { $self->{$_} = $self->{sepa}->_replace_special_chars($self->{$_}) } qw(company reference end_to_end_id);
|
|
| 40 |
map { $self->{$_} = replace_special_chars($self->{$_}) } qw(company reference end_to_end_id);
|
|
| 39 | 41 |
} |
| 40 | 42 |
|
| 41 | 43 |
sub get {
|
| t/bank/bank_transactions.t | ||
|---|---|---|
| 1 |
use Test::More tests => 137;
|
|
| 1 |
use Test::More tests => 138;
|
|
| 2 | 2 |
|
| 3 | 3 |
use strict; |
| 4 | 4 |
|
| ... | ... | |
| 119 | 119 |
)->save; |
| 120 | 120 |
|
| 121 | 121 |
$customer = new_customer( |
| 122 |
name => 'Test Customer', |
|
| 122 |
name => 'Test Customer OLÉ S.L. Årdbärg AB',
|
|
| 123 | 123 |
iban => 'DE12500105170648489890', |
| 124 | 124 |
bic => 'TESTBIC', |
| 125 | 125 |
account_number => '648489890', |
| ... | ... | |
| 710 | 710 |
vc_depositor => $customer->depositor, |
| 711 | 711 |
amount => $ar_transaction->amount, |
| 712 | 712 |
); |
| 713 |
require SL::SEPA::XML; |
|
| 714 |
my $sepa_xml = SL::SEPA::XML->new('company' => $customer->name,
|
|
| 715 |
'creditor_id' => "id", |
|
| 716 |
'src_charset' => 'UTF-8', |
|
| 717 |
'message_id' => "test", |
|
| 718 |
'grouped' => 1, |
|
| 719 |
'collection' => 1, |
|
| 720 |
); |
|
| 721 |
is($sepa_xml->{company} , 'Test Customer OLE S.L. Ardbaerg AB');
|
|
| 713 | 722 |
|
| 714 | 723 |
$ar_transaction->load; |
| 715 | 724 |
$bt->load; |
Auch abrufbar als: Unified diff
_replace_special_chars in Helper ausgelagert.
test_sepa_export in bank_transactions.t um einen Testfall
hierfür erweitert.