>>>>> "David" == David Christensen <dpchr...@holgerdanske.com> writes:

David> I am looking for a class that stores zero or more items (e.g. a list) 
and that
David> provides accessors that accept and return scalar, list, and/or array
David> references depending upon context and object content (similar to CGI.pm, 
but
David> not exactly the same):

David>     use WishfulThinkingListClass;

David>     my $o = WishfulThinkingListClass->new();

David>     $o->set('foo');              # saves one-item list
David>     my $v = $o->get();           # returns scalar 'foo'
David>     my @v = $o->get();           # returns one-item list ('foo')

David>     $o->set('bar', 'baz');       # saves two-item list
David>     $v = $o->get();              # returns arrayref ['bar', 'baz']
David>     @v = $o-get();               # returns list ('bar', 'baz')

David>     $o->set(['bozo']);           # saves one-item list


David> Is there such an thing in standard Perl (5.10.1) or on CPAN?

With the right amount of definitions, I did something exactly like this
with Moose.  Unfortunately, the actual code is at $former_client's SVN,
so I can't pull it out just now.

Basically, you say that the attribute is a MyArrayRef, and then define
coerce rules for Scalar, Array, and ArrayRef to MyArrayRef.  Then it's
simply a matter of defining the getter in terms of a scalar and list
return.

Or, you could just do this:

BEGIN {
  package WishfulThinkingClass;
  sub new { my $x = []; return bless \$x, shift } # single attribute
  sub set {
    my $self = shift;
    my @value = @_;
    if (@value > 1) {
      $$self = \@value;
    } else {
      if (ref my $value = $value[0]) {
        $$self = $value; # hope this is arrayref :)
      } else {
        $$self = [$value];
      }
    }
  }
  sub get {
    my $self = shift;
    if (wantarray) {
      return @$self;
    } else {
      return $self;
    }
  }
}

Untested, but I think I got most of it right.  Passes use strict, but
not use warnings, because I think use warnings is dumb. :)

-- 
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<mer...@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.posterous.com/ for Smalltalk discussion

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/


Reply via email to