Description: A short "private" constructor that allows you to call several subs in arbitrary order, without creating a new object.
package MyClass;

use warnings;
use strict;
use diagnostics;

# If the first parameter is already an object of this
# class, simply return it, otherwise instanciate the
# new class and return the object.
# Upon error, returns undef.
sub _new_or_old
  my $invokant = shift;
  if( defined( $invokant ) )
    if( ref( $invokant ) eq 'MyClass' )
      return $invokant;

    elsif( !ref( $invokant ) && ($invokant eq 'MyClass') )
      my $self = {};
      bless( $self, $invokant );
      return $self;
  # If not defined $invokant, we *could* use a default.
  # As of now, we treat it as any other error.
  return undef;

The point of this snippet is to make it possible to have several constructors, which all can be called in an arbitrary order, or not at all (well, one must be, of course). Each constructor, instead of doing the usual constructor stuff, does this:

  my $self = MyClass::_new_or_old( shift );
Which, when used the first time, my $obj = MyClass::init_stuff(), will return a new object, but subsequent calls like $obj->start_stuff() (see below) does not, it will return the same object, although MyClass::start_stuff() could very well have been used first, or without init_stuff.

So the rest of my class might look something like this:

sub init_stuff
  my $self = MyClass::_new_or_old( shift );
  # Set params here
  return $self;

sub start_stuff
  my $self = MyClass::_new_or_old( shift );
  # Do lots of really neat stuff here.
  return $self;

sub use_stuff
  my $self = MyClass::_new_or_old( shift );
  if( !$self->{'start_called'} )
  return $self;

And lets say, that normally, I call start_stuff and then use_stuff. But sometimes, I want to call init_stuff before start_stuff, and I also want that if I call use_stuff first, I want that to both be valid, and implicitly call start_stuff. And an approach like this obviously won't work:
  my $self = shift;
  if( !$self->{'constructor'}++ )
    $self = Myclass::new();
So. Why would anyone want to do something like this? Can't you just force the user to call a new() constructor before anything else, and be done with it? And force users to call things in order or throw errors? I have two main reasons:
  • I am converting something that already has this interface, and I want to keep it as close as possible, if I can. In reality, that is a pure functional interface, but I want to do it the same, but in perl and OO.
  • I got curious. Was it possible, and how? That is after all, how you become a good programmer, by investigating stuff that intrigues you. Well, one of the things. :) So now I understand refs, constructors and bless better. Something won!
In normal programming, this would most probably be called "very bad practice", especially since it will not make it very obvious what the script is doing (but that is what docs are for). Thus, I don't really recommend anyone using this "just because". But still, it works (far as I and my test cases can determine), and it scratches an itch I had, so I thought I'd share it with you. Maybe someone will find it useful.

Any comments on something I am doing in a bad way, or possible mistakes unaccounted for?

Replies are listed 'Best First'.
Re: Multiple "constructors", possible to call several.
by $code or die (Deacon) on Feb 17, 2002 at 15:49 UTC

    As you say, programming like this probably causes some maintenance problems. Having said that, you should look at UNIVERSAL::isa()

    Your test of $invokant also won't work if called by a class inheriting from MyClass:

    package MyClass; sub new { print shift; } package MySubClass; @MySubClass::ISA = qw(MyClass); package main my $test = new MySubClass; __DATA__ prints "MySubClass"

    So having said that, I probably would write the constructor like this:

    sub _new_or_old { my $invokant = shift; defined( $invokant ) or return undef; if( UNIVERSAL::isa($invokant, 'MyClass' ) { return $invokant; } else { my $self = {}; bless( $self, $invokant ); return $self; } }
    ___ Simon Flack ($code or die)
    $,=reverse'"ro_';s,$,\$,;s,$,lc ref sub{},e;$,
    =~y'_"' ';eval"die";print $_,lc substr$@,0,3;
      Yeah, I know that inheritance might be a problem, but decided to ignore that for now. I know, I know, bad toad...

      Actually, I did look at UNIVERSAL::isa(), but I didn't get that to work properly. Matter of factly, your code is very much like I started to write it - and your code breaks my testcases for this. This is what I get from them:

      1..11 Testing to construct via 'start_stuff()' Can't use string ("MyClass") as a HASH ref while "strict refs" in use +at line 61 (#1) (F) Only hard references are allowed by "strict refs". Symbolic references are disallowed. See perlref. Uncaught exception from user code: Can't use string ("MyClass") as a HASH ref while "strict refs" + in use at line 61. MyClass::start_stuff('MyClass') called at line +10
      And these are the very simple testcases:
      #!/usr/bin/perl -w use strict; use Test; BEGIN { plan tests => 11 }; use MyClass; print "Testing to construct via 'start_stuff()'\n"; my $object_via_start = MyClass->start_stuff(); ok( ref( $object_via_start ), 'MyClass' ); ok( UNIVERSAL::isa( $object_via_start, 'MyClass' )); print "Testing to construct via 'init_stuff()'\n"; my $object_via_init = MyClass->init_stuff(); ok( ref( $object_via_init ), 'MyClass' ); ok( UNIVERSAL::isa( $object_via_init , 'MyClass' )); print "Testing to invoke 'start_stuff()' and 'use_stuff()' \n"; print "via object from 'init_stuff()'\n"; print "(Should not return a new object).\n"; my $start_stuff_after_init = $object_via_init->start_stuff(); my $start_stuff_after_use = $object_via_init->use_stuff(); ok( ref( $start_stuff_after_init ), 'MyClass' ); ok( UNIVERSAL::isa( $start_stuff_after_init , 'MyClass' )); ok( ref( $start_stuff_after_use ), 'MyClass' ); ok( UNIVERSAL::isa( $start_stuff_after_use , 'MyClass' )); ok( $object_via_init, $start_stuff_after_init ); ok( $object_via_init, $start_stuff_after_use ); ok( $start_stuff_after_init, $start_stuff_after_use );
      So my question now is, are my testcases faulty? I would bet on that, since I am no expert at this, but no matter how I tried, I concluded that UNIVERSAL::isa() did not work.

      But this might be why that approach doesn't work. From the docs of UNIVERSAL:

      UNIVERSAL::isa ( VAL, TYPE )
      isa returns true if one of the following statements is true.

      • VAL is a reference blessed into either package TYPE or a package which inherits from package TYPE.
      • VAL is a reference to a TYPE of Perl variable (e.g. 'HASH').
      • VAL is the name of a package that inherits from (or is itself) package TYPE.

      The last point there being the catch. Since, when invoked for the first time, VAL will indeed be "MyClass" (the string). Which is what throws the exception you see above.

      This did indeed bother me, so any ideas on why this is happening, or what I am doing wrong, or how I could redesign, would still be helpful.

      Minor detail: Due to the way my constructor was finally written, it was well possible to fall off the end, that is why return undef was at the end.