From 5e9aaf1c3e83467ed4f6550627f8c7e6ec6fa811 Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Wed, 24 Apr 2013 15:19:47 +0200 Subject: [PATCH] _hashify: verallgemeinert, getestet, nach SL::Util verschoben (und das dabei erfunden) --- SL/Helper/DateTime.pm | 5 ++- SL/Template/Plugin/L.pm | 60 ++++++++++------------------- SL/Util.pm | 74 ++++++++++++++++++++++++++++++++++++ t/helper/hashify.t | 84 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 181 insertions(+), 42 deletions(-) create mode 100644 SL/Util.pm create mode 100644 t/helper/hashify.t diff --git a/SL/Helper/DateTime.pm b/SL/Helper/DateTime.pm index b72207f8a..639ed4531 100644 --- a/SL/Helper/DateTime.pm +++ b/SL/Helper/DateTime.pm @@ -2,6 +2,8 @@ package DateTime; use strict; +use SL::Util qw(_hashify); + sub now_local { return shift->now(time_zone => $::locale->get_local_time_zone); } @@ -11,8 +13,7 @@ sub today_local { } sub to_kivitendo { - my $self = shift; - my %params = (scalar(@_) == 1) && (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; + my ($self, %params) = _hashify(1, @_); return $::locale->format_date_object($self, %params); } diff --git a/SL/Template/Plugin/L.pm b/SL/Template/Plugin/L.pm index 6db220296..fa1869215 100644 --- a/SL/Template/Plugin/L.pm +++ b/SL/Template/Plugin/L.pm @@ -7,6 +7,7 @@ use List::Util qw(max); use Scalar::Util qw(blessed); use SL::Presenter; +use SL::Util qw(_hashify); use strict; @@ -30,10 +31,6 @@ sub _J { return $string; } -sub _hashify { - return (@_ && (ref($_[0]) eq 'HASH')) ? %{ $_[0] } : @_; -} - sub new { my ($class, $context, @args) = @_; @@ -75,8 +72,7 @@ sub _set_id_attribute { } sub img_tag { - my ($self, @slurp) = @_; - my %options = _hashify(@slurp); + my ($self, %options) = _hashify(1, @_); $options{alt} ||= ''; @@ -84,8 +80,7 @@ sub img_tag { } sub textarea_tag { - my ($self, $name, $content, @slurp) = @_; - my %attributes = _hashify(@slurp); + my ($self, $name, $content, %attributes) = _hashify(3, @_); _set_id_attribute(\%attributes, $name); $attributes{rows} *= 1; # required by standard @@ -96,8 +91,7 @@ sub textarea_tag { } sub checkbox_tag { - my ($self, $name, @slurp) = @_; - my %attributes = _hashify(@slurp); + my ($self, $name, %attributes) = _hashify(2, @_); _set_id_attribute(\%attributes, $name); $attributes{value} = 1 unless defined $attributes{value}; @@ -118,9 +112,7 @@ sub checkbox_tag { } sub radio_button_tag { - my $self = shift; - my $name = shift; - my %attributes = _hashify(@_); + my ($self, $name, %attributes) = _hashify(2, @_); _set_id_attribute(\%attributes, $name); $attributes{value} = 1 unless defined $attributes{value}; @@ -139,8 +131,8 @@ sub radio_button_tag { } sub hidden_tag { - my ($self, $name, $value, @slurp) = @_; - return $self->input_tag($name, $value, _hashify(@slurp), type => 'hidden'); + my ($self, $name, $value, %attributes) = _hashify(3, @_); + return $self->input_tag($name, $value, %attributes, type => 'hidden'); } sub div_tag { @@ -159,8 +151,7 @@ sub li_tag { } sub link { - my ($self, $href, $content, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $href, $content, %params) = _hashify(3, @_); $href ||= '#'; @@ -168,8 +159,7 @@ sub link { } sub submit_tag { - my ($self, $name, $value, @slurp) = @_; - my %attributes = _hashify(@slurp); + my ($self, $name, $value, %attributes) = _hashify(3, @_); if ( $attributes{confirm} ) { $attributes{onclick} = 'return confirm("'. _J(delete($attributes{confirm})) .'");'; @@ -179,8 +169,7 @@ sub submit_tag { } sub button_tag { - my ($self, $onclick, $value, @slurp) = @_; - my %attributes = _hashify(@slurp); + my ($self, $onclick, $value, %attributes) = _hashify(3, @_); _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name}; $attributes{type} ||= 'button'; @@ -201,8 +190,7 @@ sub ajax_submit_tag { } sub yes_no_tag { - my ($self, $name, $value) = splice @_, 0, 3; - my %attributes = _hashify(@_); + my ($self, $name, $value, %attributes) = _hashify(3, @_); return $self->select_tag($name, [ [ 1 => $::locale->text('Yes') ], [ 0 => $::locale->text('No') ] ], default => $value ? 1 : 0, %attributes); } @@ -228,9 +216,8 @@ sub stylesheet_tag { my $date_tag_id_idx = 0; sub date_tag { - my ($self, $name, $value, @slurp) = @_; + my ($self, $name, $value, %params) = _hashify(3, @_); - my %params = _hashify(@slurp); _set_id_attribute(\%params, $name); my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : (); my @class = $params{no_cal} || $params{readonly} ? () : (class => 'datepicker'); @@ -299,8 +286,7 @@ sub javascript_tag { } sub tabbed { - my ($self, $tabs, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $tabs, %params) = _hashify(2, @_); my $id = $params{id} || 'tab_' . _tag_id(); $params{selected} *= 1; @@ -326,8 +312,7 @@ sub tabbed { } sub tab { - my ($self, $name, $src, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $name, $src, %params) = _hashify(3, @_); $params{method} ||= 'process'; @@ -348,8 +333,7 @@ sub tab { } sub areainput_tag { - my ($self, $name, $value, @slurp) = @_; - my %attributes = _hashify(@slurp); + my ($self, $name, $value, %attributes) = _hashify(3, @_); my ($rows, $cols); my $min = delete $attributes{min_rows} || 1; @@ -367,8 +351,7 @@ sub areainput_tag { } sub multiselect2side { - my ($self, $id, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $id, %params) = _hashify(2, @_); $params{labelsx} = "\"" . _J($params{labelsx} || $::locale->text('Available')) . "\""; $params{labeldx} = "\"" . _J($params{labeldx} || $::locale->text('Selected')) . "\""; @@ -387,8 +370,7 @@ EOCODE } sub sortable_element { - my ($self, $selector, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $selector, %params) = _hashify(2, @_); my %attributes = ( distance => 5, helper => <<'JAVASCRIPT' ); @@ -445,8 +427,7 @@ JAVASCRIPT } sub online_help_tag { - my ($self, $tag, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $tag, %params) = _hashify(2, @_); my $cc = $::myconfig{countrycode}; my $file = "doc/online/$cc/$tag.html"; my $text = $params{text} || $::locale->text('Help'); @@ -463,8 +444,7 @@ sub dump { } sub sortable_table_header { - my ($self, $by, @slurp) = @_; - my %params = _hashify(@slurp); + my ($self, $by, %params) = _hashify(2, @_); my $controller = $self->{CONTEXT}->stash->get('SELF'); my $sort_spec = $controller->get_sort_spec; @@ -495,7 +475,7 @@ sub paginate_controls { my %template_params = ( pages => \%paginate_params, url_maker => sub { - my %url_params = _hashify(@_); + my %url_params = _hashify(0, @_); $url_params{ $paginate_spec->{FORM_PARAMS}->[0] } = delete $url_params{page}; $url_params{ $paginate_spec->{FORM_PARAMS}->[1] } = delete $url_params{per_page} if exists $url_params{per_page}; diff --git a/SL/Util.pm b/SL/Util.pm new file mode 100644 index 000000000..fdcc080cf --- /dev/null +++ b/SL/Util.pm @@ -0,0 +1,74 @@ +package SL::Util; + +use strict; + +use parent qw(Exporter); + +use Carp; + +our @EXPORT_OK = qw(_hashify); + +sub _hashify { + my $keep = shift; + + croak "Invalid number of entries to keep" if 0 > $keep; + + return @_[0..scalar(@_) - 1] if $keep >= scalar(@_); + return ($keep ? @_[0..$keep - 1] : (), + ((1 + $keep) == scalar(@_)) && ((ref($_[$keep]) || '') eq 'HASH') ? %{ $_[$keep] } : @_[$keep..scalar(@_) - 1]); +} + +1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Util - Assorted utility functions + +=head1 OVERVIEW + +Most important things first: + +DO NOT USE C<@EXPORT> HERE! Only C<@EXPORT_OK> is allowed! + +=head1 FUNCTIONS + +=over 4 + +=item C<_hashify $num, @args> + +Hashifies the very last argument. Returns a list consisting of two +parts: + +The first part are the first C<$num> elements of C<@args>. + +The second part depends on the remaining arguments. If exactly one +argument remains and is a hash reference then its dereferenced +elements will be used. Otherwise the remaining elements of C<@args> +will be returned as-is. + +Useful if you want to write code that can be called from Perl code and +Template code both. Example: + + use SL::Util qw(_hashify); + + sub do_stuff { + my ($self, %params) = _hashify(1, @_); + # Now do stuff, obviously! + } + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/t/helper/hashify.t b/t/helper/hashify.t new file mode 100644 index 000000000..cf45ef558 --- /dev/null +++ b/t/helper/hashify.t @@ -0,0 +1,84 @@ +use Test::More tests => 52; + +use strict; + +use lib 't'; + +use_ok 'SL::Util'; + +sub numtest { + my @result = SL::Util::_hashify(@_); + return scalar(@result); +} + +sub memtest { + my $key = shift; + my $keep = $_[0]; + my @result = SL::Util::_hashify(@_); + splice @result, 0, $keep; + + return '' if !@result; + return '' if scalar(@result) % 2; + + my %hash = @result; + return $hash{$key}; +} + +my $href = { 42 => 54, unicorn => 'charlie' }; +my %hash = ( 23 => 13, chunky => 'bacon' ); + +is(numtest(0, $href), 4, 'case A1'); +is(numtest(0, %hash), 4, 'case A2'); +is(numtest(1, $href), 1, 'case A3'); +is(numtest(1, %hash), 4, 'case A4'); +is(numtest(2, $href), 1, 'case A5'); +is(numtest(2, %hash), 4, 'case A6'); +is(numtest(3, $href), 1, 'case A7'); +is(numtest(3, %hash), 4, 'case A8'); +is(numtest(4, $href), 1, 'case A9'); +is(numtest(4, %hash), 4, 'case A10'); +is(numtest(5, $href), 1, 'case A11'); +is(numtest(5, %hash), 4, 'case A12'); + +is(numtest(0, 'dummy1', $href), 2, 'case B1'); +is(numtest(0, 'dummy1', %hash), 5, 'case B2'); +is(numtest(1, 'dummy1', $href), 5, 'case B3'); +is(numtest(1, 'dummy1', %hash), 5, 'case B4'); +is(numtest(2, 'dummy1', $href), 2, 'case B5'); +is(numtest(2, 'dummy1', %hash), 5, 'case B6'); +is(numtest(3, 'dummy1', $href), 2, 'case B7'); +is(numtest(3, 'dummy1', %hash), 5, 'case B8'); +is(numtest(4, 'dummy1', $href), 2, 'case B9'); +is(numtest(4, 'dummy1', %hash), 5, 'case B10'); +is(numtest(5, 'dummy1', $href), 2, 'case B11'); +is(numtest(5, 'dummy1', %hash), 5, 'case B12'); + +is(numtest(0, 'dummy1', 'dummy2', $href), 3, 'case C1'); +is(numtest(0, 'dummy1', 'dummy2', %hash), 6, 'case C2'); +is(numtest(1, 'dummy1', 'dummy2', $href), 3, 'case C3'); +is(numtest(1, 'dummy1', 'dummy2', %hash), 6, 'case C4'); +is(numtest(2, 'dummy1', 'dummy2', $href), 6, 'case C5'); +is(numtest(2, 'dummy1', 'dummy2', %hash), 6, 'case C6'); +is(numtest(3, 'dummy1', 'dummy2', $href), 3, 'case C7'); +is(numtest(3, 'dummy1', 'dummy2', %hash), 6, 'case C8'); +is(numtest(4, 'dummy1', 'dummy2', $href), 3, 'case C9'); +is(numtest(4, 'dummy1', 'dummy2', %hash), 6, 'case C10'); +is(numtest(5, 'dummy1', 'dummy2', $href), 3, 'case C11'); +is(numtest(5, 'dummy1', 'dummy2', %hash), 6, 'case C12'); + +is(memtest(42, 0, $href), '54', 'case D1'); +is(memtest(23, 0, %hash), '13', 'case D2'); +is(memtest('unicorn', 0, $href), 'charlie', 'case D3'); +is(memtest('chunky', 0, %hash), 'bacon', 'case D4'); +is(memtest(42, 1, $href), '', 'case D5'); +is(memtest(23, 1, %hash), '', 'case D6'); + +is(memtest(42, 0, 'dummy1', $href), undef, 'case E1'); +is(memtest(23, 0, 'dummy1', %hash), '', 'case E2'); +is(memtest('unicorn', 0, 'dummy1', $href), undef, 'case E3'); +is(memtest(42, 1, 'dummy1', $href), '54', 'case E4'); +is(memtest(23, 1, 'dummy1', %hash), '13', 'case E5'); +is(memtest('unicorn', 1, 'dymmy1', $href), 'charlie', 'case E6'); +is(memtest('chunky', 1, 'dummy1', %hash), 'bacon', 'case E7'); +is(memtest(42, 2, 'dummy1', $href), '', 'case E8'); +is(memtest(23, 2, 'dummy1', %hash), '', 'case E9'); -- 2.20.1