package Sub::Hashwrap;

use 5.00500;
use strict;
use Carp qw/croak/;

require Exporter;
use vars     qw/ $VERSION @ISA @EXPORT_OK /;
$VERSION   = '.01';
@ISA       = qw/ Exporter/;
@EXPORT_OK = qw/ wrap /;

sub wrap {
    my %wrapper = @_;
    
    foreach ( qw/ sub names / ) {
        if ( ! exists $wrapper{$_} ) {
            croak "You must supply '$_' in the argument list'";
        }
    }

    croak "'sub' value must not be a reference." unless ! ref $wrapper
+{ sub };

    my $sub = $wrapper{ sub };
    if ( $sub !~ /::/ ) {
        # if it's not fully qualified, append the package
        $sub = caller(0)."::$sub";
    }
    no strict 'refs';
    my $orig_sub;
    $orig_sub = \&$sub;
    
    $wrapper{ hashref } = 1  if ! exists $wrapper{ hashref };
    $wrapper{ default } = {} if ! exists $wrapper{ default };

    *{$sub} = sub {
        my %args = $wrapper{ hashref } ? %{$_[0]} : @_;
        my @orig_args;
        foreach my $arg_name ( @{$wrapper{ names }} ) {
            if ( exists $args{ $arg_name } ) {
                push @orig_args, $args{ $arg_name };
            } elsif ( exists $wrapper{ default }{ $arg_name } ) {
                push @orig_args, $wrapper{ default }{ $arg_name };
            } else {
                croak( "Cannot find value or default for '$arg_name'" 
+);
            }
        }
        return $orig_sub->( @orig_args );
    }
}

1;

__END__

=head1 NAME

Sub::Hashwrap - Perl extension for using named arguments with any sub

=head1 SYNOPSIS

  use Sub::Hashwrap qw/wrap/;
  wrap ( 
    sub   => some_sub_name,
    names => [qw/ names for your arguments /],
    default => {
      your => 1,
      arguments => undef
    }
  );

  some_sub_name( {
    names => [qw/Bill Mary Ovid/],
    for   => '??'
  } );
    

=head1 DESCRIPTION

Sometimes it can be a pain to work with a sub that takes a long list o
+f
arguments.   Trying to remember their order can be annoying, but it ge
+ts worse
if some of the arguments are optional.  This module allows you to use 
+named
arguments with any subroutine.  It has only one function,
C<Sub::Hashwrap::wrap>, which has two mandatory and two optional argum
+ents.

=head2 Parameters

=over 4

=item C<sub>

Required.  This argument is the name of the sub (B<not> a reference to
+ it.  If
just the sub name is provided, the calling package is assumed to be th
+e correct
one.  Otherwise, a fully-qualified sub name may be used.

This will use the calling package.

  wrap(
    sub   => 'process_report',
    names => [qw/ report summary totals /]
  );

This will use C<Some::Package::>.

  wrap(
    sub   => 'Some::Package::process_report',
    names => [qw/ report summary totals /]
  );

=item C<names>

Required.  This should be an array ref with the names of the arguments
+ in the
order in which they are supplied to the sub.  See examples for C<sub>.

=item C<hashref>

Optional.  If you would rather supply a list instead of a hashref, set
+ this to
false.  The default is true.

=item C<default>

Optional.  This is a hashref with default values for any argument that
+ you
don't supply when you call the subroutine.

=back

=head2 Example

  use Data::Dumper;
  use Sub::Hashwrap qw/wrap/;
  wrap(
    sub      => foo,
    names    => [qw/ first second third /],
    hashref  => 1,
    default  => {
      second => 'deux'
    }
  );

  foo( {first => 1, third => 3} );

  sub foo {
    print Dumper \@_;
  }

=head2 EXPORT

None by default.  Adding C<wrap> to the import list will import it.


=head1 AUTHOR

Copyright 2002, Curtis "Ovid" Poe E<lt>poec@yahoo.comE<gt>.  All right
+s
reserved.

This library is free software; you can redistribute it and/or modify i
+t under
the same terms as Perl itself.

=head1 SEE ALSO

L<perl>.

=cut
[download]

Cheers,
Ovid

Update: This is now on the CPAN as Sub::NamedParams. It now has an optional target that you can specify. The target is the new sub name taking named arguments, while still allowing the old sub name to be called with ordered arguments. This is useful in a collaborative environment where other programmers may still be using the sub in question.

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.