http://qs1969.pair.com?node_id=161533
Category: Miscellaneous
Author/Contact Info Stephen Nelson <steven@jubal.com>
Description:

Inspired by the discussion about subroutine defaults, I decided to write this...

You've probably seen it a thousand times: a subroutine begins with a complex series of defined($blah) or $blah = 'fribble' statements designed to provide reasonable default values for optional parameters. They work fine, but every once in a while one wishes that perl 5 had a simple mechanism to provide default values to subroutines.

This module attempts to fill that gap. It allows you to declare your subroutines with a 'default' attribute which you can use to specify whatever default values your subroutine should have, and automatically fills them in if they are undefined or not provided. It works on simple scalar arguments, list arguments, and hash-style named arguments.

Used like this:

use base 'Attribute::Default';

sub say_name : default('stephen') {
  my ($name) = @_;
  print "Hello, my name is $name\n";
}

# Prints "Hello, my name is john"
say_name('john');

# Prints "Hello, my name is stephen"
say_name();

[download]

Update: Added usage example to description. Fixed some code documentation.

 
package Attribute::Default;

####
#### Attribute::Default
####
#### $Id: Default.pm,v 1.4 2002/04/24 18:22:39 steven Exp $
####
#### See perldoc for details.
####

use 5.006;
use strict;
use warnings;
no warnings 'redefine';

use base 'Attribute::Handlers';

use Carp;

our $VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d
+."."%02d" x $#r, @r };


sub default : ATTR(CODE) {
    my ($package, $glob, $referent, $attr, $defaults, $phase) = @_;

    ref $defaults or $defaults = [$defaults];

    my $orig = *$glob{CODE};
    if (ref $defaults eq 'ARRAY') {
    *$glob = sub {
        my @filled = ();
        foreach (0 .. $#_) {
        push @filled, ( defined( $_[$_] ) ? $_[$_] : $defaults->[$_] )
+;
        }
        if ($#$defaults > $#_) {
        push(@filled, @$defaults[scalar @_ .. $#$defaults]);
        }
        
        @_ = @filled;
        
        goto $orig;
    };
    }
    elsif (ref $defaults eq 'HASH') {
    *$glob = sub {
        my %args = @_;
        while (my ($key, $value) = each %$defaults) {
          defined($args{$key}) or $args{$key} = $value;
        }
        @_ = %args;
        goto $orig;
    }
    }
    else {
    confess "Argument to attribute '$attr' must be an arrayref, scalar
+, or hashref; stopped";
    }

}

1;
__END__

=head1 NAME

Attribute::Default - Perl extension to assign default values to subrou
+tine arguments

=head1 SYNOPSIS

  package MyPackage;
  use base 'Attribute::Default';

  # Makes person's name default to "jimmy"
  sub introduce : default("jimmy") {
     my ($name) = @_;
     print "My name is $name\n";
  }

  # Make age default to 14, sex default to male
  sub vitals : default({age => 14, sex => 'male'}) {
     my %vitals = @_;
     print "I'm $vitals{'sex'}, $vitals{'age'} years old, and am from 
+$vitals{'location'}\n";
  }


=head1 DESCRIPTION

You've probably seen it a thousand times: a subroutine begins with a
complex series of C<defined($blah) or $blah = 'fribble'> statements
designed to provide reasonable default values for optional
parameters. They work fine, but every once in a while one wishes that
perl 5 had a simple mechanism to provide default values to
subroutines.

This module attempts to fill that gap. If you would like to have a
subroutine that takes three parameters, but the second two should
default to 'Mister Morton' and 'walked', you can declare it like this:

  package WhateverPackage;
  use base 'Attribute::Default';

  sub what_happened : default(undef, 'Mister Morton', 'walked down the
+ street') {
    my ($time, $subject, $verb) = @_;

    print "At $time, $subject $verb\n";
  }

and C<$subject> and C<$verb> will automatically be filled in when
someone calls the C<what_happened()> subroutine with only a single
argument.

  # prints "At 12AM, Mister Morton walked down the street"
  what_happened('12AM');

  # prints "At 3AM, Interplanet Janet walked down the street"
  what_happened('3AM', 'Interplanet Janet');

  # prints "At 6PM, a bill got passed into law"
  what_happened('6PM', 'a bill', 'got passed into law');

  # prints "At 7:03 PM, Mister Morton grew flowers for Perl"
  what_happened("7:03 PM", undef, "grew flowers for Perl");

You can also use the default mechanism to handle the named parameter
style of coding. Just pass a hash reference as the value of
C<default()>, like so:

  package YetAnotherPackage;
  use base 'Attribute::Default';

  sub found_pet : default({name => 'Rufus Xavier Sarsaparilla', pet =>
+ 'kangaroo'}) {
    my %args = @_;
    my ($first_name) = split(/ /, $args{'name'}, 2);
    print "$first_name found a $args{'pet'} that followed $first_name 
+home\n"; 
    print "And now that $args{'pet'} belongs...\n";
    print "To $args{'name'}.\n\n";
  }

  # Prints "Rufus found a kangaroo that followed Rufus home"...
  found_pet();

  # Prints "Rafaella found a kangaroo that followed Rafaella home"...
  found_pet(name => 'Rafaella Gabriela Sarsaparilla');

  # Or...
  found_pet(name => 'Rafaella Gabriela Sarsaparilla', pet => undef);

  # Prints "Albert found a rhinoceros that followed Albert home"...
  found_pet(name => 'Albert Andreas Armadillo', pet => 'rhinoceros');
  

=head1 BUGS

An alpha module. Bugs unknown but probably plentiful. Based on The
Damian's Attribute::Handlers, so shares whatever bugs may be found
there. The installation process cannot use the normal mechanism for
auto-installing Attribute::Handlers, so I'm afraid you'll have to
install it yourself if it's not there.

=head1 AUTHOR

Stephen Nelson, E<lt>steven@jubal.comE<gt>

=head1 SEE ALSO

L<Attribute::Handlers>.

=cut

Back to Code Catacombs