Revision 5e9aaf1c
Von Moritz Bunkus vor fast 12 Jahren hinzugefügt
SL/Helper/DateTime.pm | ||
---|---|---|
|
||
use strict;
|
||
|
||
use SL::Util qw(_hashify);
|
||
|
||
sub now_local {
|
||
return shift->now(time_zone => $::locale->get_local_time_zone);
|
||
}
|
||
... | ... | |
}
|
||
|
||
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);
|
||
}
|
||
|
SL/Template/Plugin/L.pm | ||
---|---|---|
use Scalar::Util qw(blessed);
|
||
|
||
use SL::Presenter;
|
||
use SL::Util qw(_hashify);
|
||
|
||
use strict;
|
||
|
||
... | ... | |
return $string;
|
||
}
|
||
|
||
sub _hashify {
|
||
return (@_ && (ref($_[0]) eq 'HASH')) ? %{ $_[0] } : @_;
|
||
}
|
||
|
||
sub new {
|
||
my ($class, $context, @args) = @_;
|
||
|
||
... | ... | |
}
|
||
|
||
sub img_tag {
|
||
my ($self, @slurp) = @_;
|
||
my %options = _hashify(@slurp);
|
||
my ($self, %options) = _hashify(1, @_);
|
||
|
||
$options{alt} ||= '';
|
||
|
||
... | ... | |
}
|
||
|
||
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
|
||
... | ... | |
}
|
||
|
||
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};
|
||
... | ... | |
}
|
||
|
||
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};
|
||
... | ... | |
}
|
||
|
||
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 {
|
||
... | ... | |
}
|
||
|
||
sub link {
|
||
my ($self, $href, $content, @slurp) = @_;
|
||
my %params = _hashify(@slurp);
|
||
my ($self, $href, $content, %params) = _hashify(3, @_);
|
||
|
||
$href ||= '#';
|
||
|
||
... | ... | |
}
|
||
|
||
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})) .'");';
|
||
... | ... | |
}
|
||
|
||
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';
|
||
... | ... | |
}
|
||
|
||
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);
|
||
}
|
||
... | ... | |
|
||
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');
|
||
... | ... | |
}
|
||
|
||
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;
|
||
... | ... | |
}
|
||
|
||
sub tab {
|
||
my ($self, $name, $src, @slurp) = @_;
|
||
my %params = _hashify(@slurp);
|
||
my ($self, $name, $src, %params) = _hashify(3, @_);
|
||
|
||
$params{method} ||= 'process';
|
||
|
||
... | ... | |
}
|
||
|
||
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;
|
||
... | ... | |
}
|
||
|
||
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')) . "\"";
|
||
... | ... | |
}
|
||
|
||
sub sortable_element {
|
||
my ($self, $selector, @slurp) = @_;
|
||
my %params = _hashify(@slurp);
|
||
my ($self, $selector, %params) = _hashify(2, @_);
|
||
|
||
my %attributes = ( distance => 5,
|
||
helper => <<'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');
|
||
... | ... | |
}
|
||
|
||
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;
|
||
... | ... | |
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};
|
||
|
SL/Util.pm | ||
---|---|---|
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 E<lt>m.bunkus@linet-services.deE<gt>
|
||
|
||
=cut
|
t/helper/hashify.t | ||
---|---|---|
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 '<empty>' if !@result;
|
||
return '<odd-sized>' 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), '<empty>', 'case D5');
|
||
is(memtest(23, 1, %hash), '<odd-sized>', 'case D6');
|
||
|
||
is(memtest(42, 0, 'dummy1', $href), undef, 'case E1');
|
||
is(memtest(23, 0, 'dummy1', %hash), '<odd-sized>', '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), '<empty>', 'case E8');
|
||
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)