#!perl ## no critic (TidyCode)
use strict;
use warnings;
our $VERSION = 0;
use Tie::Sub;
# 1 parameter, 1 return
tie my %sprintf_04d, 'Tie::Sub', sub { sprintf '%04d', shift }; ## no critic (Ties)
() = print "See $sprintf_04d{4}, not $sprintf_04d{5} digits.\n\n";
# many parameters, 1 return
tie my %sprintf, 'Tie::Sub', sub {sprintf shift, shift}; ## no critic (Ties)
() = print "See $sprintf{ [ '%04d', 4 ] } digits.\n\n";
# many parameters, many return
tie my %sprintf_multi, 'Tie::Sub', sub { ## no critic (Ties)
return
! @_
? q{}
: @_ > 1
? [ map { sprintf "%04d\n", $_ } @_ ]
: sprintf "%04d\n", shift;
};
{
use English qw(-no_match_vars $LIST_SEPARATOR);
local $LIST_SEPARATOR = q{};
() = print <<"EOT";
See the following lines
scalar
$sprintf_multi{10}
arrayref
@{ $sprintf_multi{[20 .. 22]} }
and be lucky.
EOT
}
# method calls
my $cgi = CGI->new;
tie my %cgi, 'Tie::Sub', sub { ## no critic (Ties)
my ($method, @params) = @_;
my @result = $cgi->$method(@params);
return
! @result
? ()
: @result > 1
? \@result
: $result[0];
};
() = print <<"EOT";
Hello $cgi{ [ param => 'firstname' ] } $cgi{ [ param => 'lastname' ] }!
EOT
# package simulation
package CGI;
sub new {
return bless {}, shift;
}
sub param {
my (undef, $name) = @_;
return {
firstname => 'Steffen',
lastname => 'Winkler',
}->{$name};
}
# $Id$
__END__
Output:
See 0004, not 0005 digits.
See 0004 digits.
See the following lines
scalar
0010
arrayref
0020
0021
0022
and be lucky.
Hello Steffen Winkler!