When I say "cleanly" subclass, what I mean is:

• No hardcoded class names, outside of the initial @ISA or use base statements
• Minimal repeated effort in coding for identical functionality

Time::Piece is interesting, because it grafts object oriented functionality onto existing procedures, gmtime() and localtime(). In order to do so, the module resorts to some tricks. These procedures are drop-in replacements, so they must appear to behave just like the old ones, to wit:

• Accept the number of seconds since the epoch as an optional scalar argument
• Stringify to a date description in scalar context
• Return standard time structure components in list context

The procedures provided by Time::Piece ultimately call the _mktime() factory method. Here is the code for the critters in question:

sub gmtime {
    my $time = shift;
    $time = time if (!defined $time);
    _mktime($time, 0);
}

sub _mktime {
    my ($time, $islocal) = @_;
    if (ref($time)) {
    $time->[c_epoch] = undef;
    return wantarray ? @$time : bless [@$time, $islocal],
                                          'Time::Piece';
    }
    my @time = $islocal ?
            CORE::localtime($time)
                :
            CORE::gmtime($time);
    wantarray ? @time : bless [@time, $time, $islocal], 'Time::Piece';
}
[download]

There are two things here that bother me right of the bat. First, most importantly, the main constructor for this module is presented as a private method. In order to provide "interesting" subclasses, we will no doubt be wanting to perform additional tasks during construction. We have to ignore this privacy indicator and override _mktime(). Second, the module name 'Time::Piece' is hard coded into the blessings here, rather than deriving the class name from either a ref statement or static invocation. (As a maintenance aside, I would use __PACKAGE__ here rather than hard coding the class name, but ideally class name would be derived as just described). Real problems arise once we realise that _mktime() is expected to act both as a method and as a procedure.

In order to handle seconds since the epoch as an argument, this factory method assumes such is the case when it encounters a non-reference scalar as an argument. The gmtime() and localtime implementations assume this as well, so _mktime() is invoked procedurally. This means that we are forced to provide our own implementations for gmtime() and localtime() to ensure our overridden factory method is invoked.

When you wish to override _mktime(), we are limited to calls from blessed object references. Static calls to SUPER using indirect syntax no longer work:

Time::MyPiece->SUPER::_mktime()

As you may recall, this static invocation means that the scalar string 'Time::MyPiece' is now passed as the first argument to the method...er, procedure. This string is not the number of seconds since the epoch, though it is how it will be treated.

What to do? I can think of two avenues. First, I could pester the author of Time::Piece to patch the module in such a way as to make it more amicable to subclassing. See below for at least one tweak in that direction.

Meanwhile, I'll have to make do with current reality. I need a way of invoking SUPER functionality on a procedural method -- some way of "inheriting" a non-OO piece of code, without hard coding the name of the parent class. One option is to directly traverse @ISA, though I fear it might land me in Perl Programmer Hell:

  package Time::MyPiece;
  use base 'Time::Piece';
  my $SUPER;
  foreach (@ISA) {
    $SUPER = $_ and last if $_->can('_mktime');
  }

  ...

  sub _mktime {
    my $t;
    eval "$t = $SUPER::_mktime(@_)";
  }
[download]

One drawback to this approach is that it assumes the parent class has also come up with a way to handle this situation in cases where it inherited the method in question.

Can anyone come up with a clean way to do this?

Meanwhile, what to do with Time::Piece? Is a fundamental redesign the answer, or would a tweak such as the following suffice:

sub _mktime {
    my ($time, $islocal) = @_;
    my $class;
    if (ref $time) {
      $class = ref $time;
    }
    elsif ($time =~ /^\D+$/) {
      $class = $time;
      $time = $class->new(@_);
    }
    if (ref($time)) {
    $time->[c_epoch] = undef;
    return wantarray ? @$time : bless [@$time, $islocal], $class;
    }
    my @time = $islocal ?
            CORE::localtime($time)
                :
            CORE::gmtime($time);
    wantarray ? @time : bless [@time, $time, $islocal], $class;
}
[download]

I feel I am certainly missing something obvious. Feel free to pontificate on alternate approaches and solutions.

Matt