Revision 5e9aaf1c
Von Moritz Bunkus vor mehr als 11 Jahren hinzugefügt
| SL/Helper/DateTime.pm | ||
|---|---|---|
| 2 | 2 |
|
| 3 | 3 |
use strict; |
| 4 | 4 |
|
| 5 |
use SL::Util qw(_hashify); |
|
| 6 |
|
|
| 5 | 7 |
sub now_local {
|
| 6 | 8 |
return shift->now(time_zone => $::locale->get_local_time_zone); |
| 7 | 9 |
} |
| ... | ... | |
| 11 | 13 |
} |
| 12 | 14 |
|
| 13 | 15 |
sub to_kivitendo {
|
| 14 |
my $self = shift; |
|
| 15 |
my %params = (scalar(@_) == 1) && (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_;
|
|
| 16 |
my ($self, %params) = _hashify(1, @_); |
|
| 16 | 17 |
return $::locale->format_date_object($self, %params); |
| 17 | 18 |
} |
| 18 | 19 |
|
| SL/Template/Plugin/L.pm | ||
|---|---|---|
| 7 | 7 |
use Scalar::Util qw(blessed); |
| 8 | 8 |
|
| 9 | 9 |
use SL::Presenter; |
| 10 |
use SL::Util qw(_hashify); |
|
| 10 | 11 |
|
| 11 | 12 |
use strict; |
| 12 | 13 |
|
| ... | ... | |
| 30 | 31 |
return $string; |
| 31 | 32 |
} |
| 32 | 33 |
|
| 33 |
sub _hashify {
|
|
| 34 |
return (@_ && (ref($_[0]) eq 'HASH')) ? %{ $_[0] } : @_;
|
|
| 35 |
} |
|
| 36 |
|
|
| 37 | 34 |
sub new {
|
| 38 | 35 |
my ($class, $context, @args) = @_; |
| 39 | 36 |
|
| ... | ... | |
| 75 | 72 |
} |
| 76 | 73 |
|
| 77 | 74 |
sub img_tag {
|
| 78 |
my ($self, @slurp) = @_; |
|
| 79 |
my %options = _hashify(@slurp); |
|
| 75 |
my ($self, %options) = _hashify(1, @_); |
|
| 80 | 76 |
|
| 81 | 77 |
$options{alt} ||= '';
|
| 82 | 78 |
|
| ... | ... | |
| 84 | 80 |
} |
| 85 | 81 |
|
| 86 | 82 |
sub textarea_tag {
|
| 87 |
my ($self, $name, $content, @slurp) = @_; |
|
| 88 |
my %attributes = _hashify(@slurp); |
|
| 83 |
my ($self, $name, $content, %attributes) = _hashify(3, @_); |
|
| 89 | 84 |
|
| 90 | 85 |
_set_id_attribute(\%attributes, $name); |
| 91 | 86 |
$attributes{rows} *= 1; # required by standard
|
| ... | ... | |
| 96 | 91 |
} |
| 97 | 92 |
|
| 98 | 93 |
sub checkbox_tag {
|
| 99 |
my ($self, $name, @slurp) = @_; |
|
| 100 |
my %attributes = _hashify(@slurp); |
|
| 94 |
my ($self, $name, %attributes) = _hashify(2, @_); |
|
| 101 | 95 |
|
| 102 | 96 |
_set_id_attribute(\%attributes, $name); |
| 103 | 97 |
$attributes{value} = 1 unless defined $attributes{value};
|
| ... | ... | |
| 118 | 112 |
} |
| 119 | 113 |
|
| 120 | 114 |
sub radio_button_tag {
|
| 121 |
my $self = shift; |
|
| 122 |
my $name = shift; |
|
| 123 |
my %attributes = _hashify(@_); |
|
| 115 |
my ($self, $name, %attributes) = _hashify(2, @_); |
|
| 124 | 116 |
|
| 125 | 117 |
_set_id_attribute(\%attributes, $name); |
| 126 | 118 |
$attributes{value} = 1 unless defined $attributes{value};
|
| ... | ... | |
| 139 | 131 |
} |
| 140 | 132 |
|
| 141 | 133 |
sub hidden_tag {
|
| 142 |
my ($self, $name, $value, @slurp) = @_;
|
|
| 143 |
return $self->input_tag($name, $value, _hashify(@slurp), type => 'hidden');
|
|
| 134 |
my ($self, $name, $value, %attributes) = _hashify(3, @_);
|
|
| 135 |
return $self->input_tag($name, $value, %attributes, type => 'hidden');
|
|
| 144 | 136 |
} |
| 145 | 137 |
|
| 146 | 138 |
sub div_tag {
|
| ... | ... | |
| 159 | 151 |
} |
| 160 | 152 |
|
| 161 | 153 |
sub link {
|
| 162 |
my ($self, $href, $content, @slurp) = @_; |
|
| 163 |
my %params = _hashify(@slurp); |
|
| 154 |
my ($self, $href, $content, %params) = _hashify(3, @_); |
|
| 164 | 155 |
|
| 165 | 156 |
$href ||= '#'; |
| 166 | 157 |
|
| ... | ... | |
| 168 | 159 |
} |
| 169 | 160 |
|
| 170 | 161 |
sub submit_tag {
|
| 171 |
my ($self, $name, $value, @slurp) = @_; |
|
| 172 |
my %attributes = _hashify(@slurp); |
|
| 162 |
my ($self, $name, $value, %attributes) = _hashify(3, @_); |
|
| 173 | 163 |
|
| 174 | 164 |
if ( $attributes{confirm} ) {
|
| 175 | 165 |
$attributes{onclick} = 'return confirm("'. _J(delete($attributes{confirm})) .'");';
|
| ... | ... | |
| 179 | 169 |
} |
| 180 | 170 |
|
| 181 | 171 |
sub button_tag {
|
| 182 |
my ($self, $onclick, $value, @slurp) = @_; |
|
| 183 |
my %attributes = _hashify(@slurp); |
|
| 172 |
my ($self, $onclick, $value, %attributes) = _hashify(3, @_); |
|
| 184 | 173 |
|
| 185 | 174 |
_set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
|
| 186 | 175 |
$attributes{type} ||= 'button';
|
| ... | ... | |
| 201 | 190 |
} |
| 202 | 191 |
|
| 203 | 192 |
sub yes_no_tag {
|
| 204 |
my ($self, $name, $value) = splice @_, 0, 3; |
|
| 205 |
my %attributes = _hashify(@_); |
|
| 193 |
my ($self, $name, $value, %attributes) = _hashify(3, @_); |
|
| 206 | 194 |
|
| 207 | 195 |
return $self->select_tag($name, [ [ 1 => $::locale->text('Yes') ], [ 0 => $::locale->text('No') ] ], default => $value ? 1 : 0, %attributes);
|
| 208 | 196 |
} |
| ... | ... | |
| 228 | 216 |
|
| 229 | 217 |
my $date_tag_id_idx = 0; |
| 230 | 218 |
sub date_tag {
|
| 231 |
my ($self, $name, $value, @slurp) = @_;
|
|
| 219 |
my ($self, $name, $value, %params) = _hashify(3, @_);
|
|
| 232 | 220 |
|
| 233 |
my %params = _hashify(@slurp); |
|
| 234 | 221 |
_set_id_attribute(\%params, $name); |
| 235 | 222 |
my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : ();
|
| 236 | 223 |
my @class = $params{no_cal} || $params{readonly} ? () : (class => 'datepicker');
|
| ... | ... | |
| 299 | 286 |
} |
| 300 | 287 |
|
| 301 | 288 |
sub tabbed {
|
| 302 |
my ($self, $tabs, @slurp) = @_; |
|
| 303 |
my %params = _hashify(@slurp); |
|
| 289 |
my ($self, $tabs, %params) = _hashify(2, @_); |
|
| 304 | 290 |
my $id = $params{id} || 'tab_' . _tag_id();
|
| 305 | 291 |
|
| 306 | 292 |
$params{selected} *= 1;
|
| ... | ... | |
| 326 | 312 |
} |
| 327 | 313 |
|
| 328 | 314 |
sub tab {
|
| 329 |
my ($self, $name, $src, @slurp) = @_; |
|
| 330 |
my %params = _hashify(@slurp); |
|
| 315 |
my ($self, $name, $src, %params) = _hashify(3, @_); |
|
| 331 | 316 |
|
| 332 | 317 |
$params{method} ||= 'process';
|
| 333 | 318 |
|
| ... | ... | |
| 348 | 333 |
} |
| 349 | 334 |
|
| 350 | 335 |
sub areainput_tag {
|
| 351 |
my ($self, $name, $value, @slurp) = @_; |
|
| 352 |
my %attributes = _hashify(@slurp); |
|
| 336 |
my ($self, $name, $value, %attributes) = _hashify(3, @_); |
|
| 353 | 337 |
|
| 354 | 338 |
my ($rows, $cols); |
| 355 | 339 |
my $min = delete $attributes{min_rows} || 1;
|
| ... | ... | |
| 367 | 351 |
} |
| 368 | 352 |
|
| 369 | 353 |
sub multiselect2side {
|
| 370 |
my ($self, $id, @slurp) = @_; |
|
| 371 |
my %params = _hashify(@slurp); |
|
| 354 |
my ($self, $id, %params) = _hashify(2, @_); |
|
| 372 | 355 |
|
| 373 | 356 |
$params{labelsx} = "\"" . _J($params{labelsx} || $::locale->text('Available')) . "\"";
|
| 374 | 357 |
$params{labeldx} = "\"" . _J($params{labeldx} || $::locale->text('Selected')) . "\"";
|
| ... | ... | |
| 387 | 370 |
} |
| 388 | 371 |
|
| 389 | 372 |
sub sortable_element {
|
| 390 |
my ($self, $selector, @slurp) = @_; |
|
| 391 |
my %params = _hashify(@slurp); |
|
| 373 |
my ($self, $selector, %params) = _hashify(2, @_); |
|
| 392 | 374 |
|
| 393 | 375 |
my %attributes = ( distance => 5, |
| 394 | 376 |
helper => <<'JAVASCRIPT' ); |
| ... | ... | |
| 445 | 427 |
} |
| 446 | 428 |
|
| 447 | 429 |
sub online_help_tag {
|
| 448 |
my ($self, $tag, @slurp) = @_; |
|
| 449 |
my %params = _hashify(@slurp); |
|
| 430 |
my ($self, $tag, %params) = _hashify(2, @_); |
|
| 450 | 431 |
my $cc = $::myconfig{countrycode};
|
| 451 | 432 |
my $file = "doc/online/$cc/$tag.html"; |
| 452 | 433 |
my $text = $params{text} || $::locale->text('Help');
|
| ... | ... | |
| 463 | 444 |
} |
| 464 | 445 |
|
| 465 | 446 |
sub sortable_table_header {
|
| 466 |
my ($self, $by, @slurp) = @_; |
|
| 467 |
my %params = _hashify(@slurp); |
|
| 447 |
my ($self, $by, %params) = _hashify(2, @_); |
|
| 468 | 448 |
|
| 469 | 449 |
my $controller = $self->{CONTEXT}->stash->get('SELF');
|
| 470 | 450 |
my $sort_spec = $controller->get_sort_spec; |
| ... | ... | |
| 495 | 475 |
my %template_params = ( |
| 496 | 476 |
pages => \%paginate_params, |
| 497 | 477 |
url_maker => sub {
|
| 498 |
my %url_params = _hashify(@_); |
|
| 478 |
my %url_params = _hashify(0, @_);
|
|
| 499 | 479 |
$url_params{ $paginate_spec->{FORM_PARAMS}->[0] } = delete $url_params{page};
|
| 500 | 480 |
$url_params{ $paginate_spec->{FORM_PARAMS}->[1] } = delete $url_params{per_page} if exists $url_params{per_page};
|
| 501 | 481 |
|
| SL/Util.pm | ||
|---|---|---|
| 1 |
package SL::Util; |
|
| 2 |
|
|
| 3 |
use strict; |
|
| 4 |
|
|
| 5 |
use parent qw(Exporter); |
|
| 6 |
|
|
| 7 |
use Carp; |
|
| 8 |
|
|
| 9 |
our @EXPORT_OK = qw(_hashify); |
|
| 10 |
|
|
| 11 |
sub _hashify {
|
|
| 12 |
my $keep = shift; |
|
| 13 |
|
|
| 14 |
croak "Invalid number of entries to keep" if 0 > $keep; |
|
| 15 |
|
|
| 16 |
return @_[0..scalar(@_) - 1] if $keep >= scalar(@_); |
|
| 17 |
return ($keep ? @_[0..$keep - 1] : (), |
|
| 18 |
((1 + $keep) == scalar(@_)) && ((ref($_[$keep]) || '') eq 'HASH') ? %{ $_[$keep] } : @_[$keep..scalar(@_) - 1]);
|
|
| 19 |
} |
|
| 20 |
|
|
| 21 |
1; |
|
| 22 |
__END__ |
|
| 23 |
|
|
| 24 |
=pod |
|
| 25 |
|
|
| 26 |
=encoding utf8 |
|
| 27 |
|
|
| 28 |
=head1 NAME |
|
| 29 |
|
|
| 30 |
SL::Util - Assorted utility functions |
|
| 31 |
|
|
| 32 |
=head1 OVERVIEW |
|
| 33 |
|
|
| 34 |
Most important things first: |
|
| 35 |
|
|
| 36 |
DO NOT USE C<@EXPORT> HERE! Only C<@EXPORT_OK> is allowed! |
|
| 37 |
|
|
| 38 |
=head1 FUNCTIONS |
|
| 39 |
|
|
| 40 |
=over 4 |
|
| 41 |
|
|
| 42 |
=item C<_hashify $num, @args> |
|
| 43 |
|
|
| 44 |
Hashifies the very last argument. Returns a list consisting of two |
|
| 45 |
parts: |
|
| 46 |
|
|
| 47 |
The first part are the first C<$num> elements of C<@args>. |
|
| 48 |
|
|
| 49 |
The second part depends on the remaining arguments. If exactly one |
|
| 50 |
argument remains and is a hash reference then its dereferenced |
|
| 51 |
elements will be used. Otherwise the remaining elements of C<@args> |
|
| 52 |
will be returned as-is. |
|
| 53 |
|
|
| 54 |
Useful if you want to write code that can be called from Perl code and |
|
| 55 |
Template code both. Example: |
|
| 56 |
|
|
| 57 |
use SL::Util qw(_hashify); |
|
| 58 |
|
|
| 59 |
sub do_stuff {
|
|
| 60 |
my ($self, %params) = _hashify(1, @_); |
|
| 61 |
# Now do stuff, obviously! |
|
| 62 |
} |
|
| 63 |
|
|
| 64 |
=back |
|
| 65 |
|
|
| 66 |
=head1 BUGS |
|
| 67 |
|
|
| 68 |
Nothing here yet. |
|
| 69 |
|
|
| 70 |
=head1 AUTHOR |
|
| 71 |
|
|
| 72 |
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt> |
|
| 73 |
|
|
| 74 |
=cut |
|
| t/helper/hashify.t | ||
|---|---|---|
| 1 |
use Test::More tests => 52; |
|
| 2 |
|
|
| 3 |
use strict; |
|
| 4 |
|
|
| 5 |
use lib 't'; |
|
| 6 |
|
|
| 7 |
use_ok 'SL::Util'; |
|
| 8 |
|
|
| 9 |
sub numtest {
|
|
| 10 |
my @result = SL::Util::_hashify(@_); |
|
| 11 |
return scalar(@result); |
|
| 12 |
} |
|
| 13 |
|
|
| 14 |
sub memtest {
|
|
| 15 |
my $key = shift; |
|
| 16 |
my $keep = $_[0]; |
|
| 17 |
my @result = SL::Util::_hashify(@_); |
|
| 18 |
splice @result, 0, $keep; |
|
| 19 |
|
|
| 20 |
return '<empty>' if !@result; |
|
| 21 |
return '<odd-sized>' if scalar(@result) % 2; |
|
| 22 |
|
|
| 23 |
my %hash = @result; |
|
| 24 |
return $hash{$key};
|
|
| 25 |
} |
|
| 26 |
|
|
| 27 |
my $href = { 42 => 54, unicorn => 'charlie' };
|
|
| 28 |
my %hash = ( 23 => 13, chunky => 'bacon' ); |
|
| 29 |
|
|
| 30 |
is(numtest(0, $href), 4, 'case A1'); |
|
| 31 |
is(numtest(0, %hash), 4, 'case A2'); |
|
| 32 |
is(numtest(1, $href), 1, 'case A3'); |
|
| 33 |
is(numtest(1, %hash), 4, 'case A4'); |
|
| 34 |
is(numtest(2, $href), 1, 'case A5'); |
|
| 35 |
is(numtest(2, %hash), 4, 'case A6'); |
|
| 36 |
is(numtest(3, $href), 1, 'case A7'); |
|
| 37 |
is(numtest(3, %hash), 4, 'case A8'); |
|
| 38 |
is(numtest(4, $href), 1, 'case A9'); |
|
| 39 |
is(numtest(4, %hash), 4, 'case A10'); |
|
| 40 |
is(numtest(5, $href), 1, 'case A11'); |
|
| 41 |
is(numtest(5, %hash), 4, 'case A12'); |
|
| 42 |
|
|
| 43 |
is(numtest(0, 'dummy1', $href), 2, 'case B1'); |
|
| 44 |
is(numtest(0, 'dummy1', %hash), 5, 'case B2'); |
|
| 45 |
is(numtest(1, 'dummy1', $href), 5, 'case B3'); |
|
| 46 |
is(numtest(1, 'dummy1', %hash), 5, 'case B4'); |
|
| 47 |
is(numtest(2, 'dummy1', $href), 2, 'case B5'); |
|
| 48 |
is(numtest(2, 'dummy1', %hash), 5, 'case B6'); |
|
| 49 |
is(numtest(3, 'dummy1', $href), 2, 'case B7'); |
|
| 50 |
is(numtest(3, 'dummy1', %hash), 5, 'case B8'); |
|
| 51 |
is(numtest(4, 'dummy1', $href), 2, 'case B9'); |
|
| 52 |
is(numtest(4, 'dummy1', %hash), 5, 'case B10'); |
|
| 53 |
is(numtest(5, 'dummy1', $href), 2, 'case B11'); |
|
| 54 |
is(numtest(5, 'dummy1', %hash), 5, 'case B12'); |
|
| 55 |
|
|
| 56 |
is(numtest(0, 'dummy1', 'dummy2', $href), 3, 'case C1'); |
|
| 57 |
is(numtest(0, 'dummy1', 'dummy2', %hash), 6, 'case C2'); |
|
| 58 |
is(numtest(1, 'dummy1', 'dummy2', $href), 3, 'case C3'); |
|
| 59 |
is(numtest(1, 'dummy1', 'dummy2', %hash), 6, 'case C4'); |
|
| 60 |
is(numtest(2, 'dummy1', 'dummy2', $href), 6, 'case C5'); |
|
| 61 |
is(numtest(2, 'dummy1', 'dummy2', %hash), 6, 'case C6'); |
|
| 62 |
is(numtest(3, 'dummy1', 'dummy2', $href), 3, 'case C7'); |
|
| 63 |
is(numtest(3, 'dummy1', 'dummy2', %hash), 6, 'case C8'); |
|
| 64 |
is(numtest(4, 'dummy1', 'dummy2', $href), 3, 'case C9'); |
|
| 65 |
is(numtest(4, 'dummy1', 'dummy2', %hash), 6, 'case C10'); |
|
| 66 |
is(numtest(5, 'dummy1', 'dummy2', $href), 3, 'case C11'); |
|
| 67 |
is(numtest(5, 'dummy1', 'dummy2', %hash), 6, 'case C12'); |
|
| 68 |
|
|
| 69 |
is(memtest(42, 0, $href), '54', 'case D1'); |
|
| 70 |
is(memtest(23, 0, %hash), '13', 'case D2'); |
|
| 71 |
is(memtest('unicorn', 0, $href), 'charlie', 'case D3');
|
|
| 72 |
is(memtest('chunky', 0, %hash), 'bacon', 'case D4');
|
|
| 73 |
is(memtest(42, 1, $href), '<empty>', 'case D5'); |
|
| 74 |
is(memtest(23, 1, %hash), '<odd-sized>', 'case D6'); |
|
| 75 |
|
|
| 76 |
is(memtest(42, 0, 'dummy1', $href), undef, 'case E1'); |
|
| 77 |
is(memtest(23, 0, 'dummy1', %hash), '<odd-sized>', 'case E2'); |
|
| 78 |
is(memtest('unicorn', 0, 'dummy1', $href), undef, 'case E3');
|
|
| 79 |
is(memtest(42, 1, 'dummy1', $href), '54', 'case E4'); |
|
| 80 |
is(memtest(23, 1, 'dummy1', %hash), '13', 'case E5'); |
|
| 81 |
is(memtest('unicorn', 1, 'dymmy1', $href), 'charlie', 'case E6');
|
|
| 82 |
is(memtest('chunky', 1, 'dummy1', %hash), 'bacon', 'case E7');
|
|
| 83 |
is(memtest(42, 2, 'dummy1', $href), '<empty>', 'case E8'); |
|
| 84 |
is(memtest(23, 2, 'dummy1', %hash), '<odd-sized>', 'case E9'); |
|
Auch abrufbar als: Unified diff
_hashify: verallgemeinert, getestet, nach SL::Util verschoben (und das dabei erfunden)