Moose object stored in globref

One of the draftbacks of Moose is that it doesn't play nicely with non-hash based classes. It is unfortunate, because some objects have to be stored in globrefs, i.e. IO::Handle. I found the accessors are the only problem and it can be solved with additional meta-policy. So there is Moose::Policy::GlobRefObject. The working example:

package My::IO;

use Moose::Policy 'Moose::Policy::GlobRefObject';
use Moose;

has 'filename' => ( is => 'ro', isa => 'Str', required => 1 );

sub new {
    my $class = shift;

    my $self = Moose::Object::new($class, @_);

    select select my $fh;
    ${*$fh} = $self;
    return bless $fh => $class;
}

sub open {
    my $fh = shift;
    my $self = ${*$fh};
    open $fh, $self->filename or confess "cannot open";
    return $fh;
}

sub getlines {
    my $fh = shift;
    return readline $fh;
}

my $io = new My::IO filename=>'/etc/passwd';
print "filename=", $io->filename, "\n";
$io->open;
print $io->getlines;
[download]

The module itself:

#!/usr/bin/perl -c

package Moose::Policy::GlobRefObject;
use 5.006;
our $VERSION = 0.01;

=head1 NAME 

Moose::Policy::GlobRefObject - store a Moose object in glob reference

=head1 SYNOPSIS

  package My::IO;

  use Moose::Policy 'Moose::Policy::GlobRefObject';
  use Moose;

  has 'filename' => ( is => 'ro', isa => 'Str', required => 1 );

  sub new {
    my $class = shift;

    my $self = Moose::Object::new($class, @_);

    select select my $fh;
    ${*$fh} = $self;

    return bless $fh => $class;
  }

  sub open {
    my $fh = shift;
    my $self = ${*$fh};
    open $fh, $self->filename or confess "cannot open";
    return $fh;
  }

  sub getlines {
    my $fh = shift;
    return readline $fh;
  }

  my $io = new My::IO filename=>'/etc/passwd';
  print "filename=", $io->filename, "\n";
  $io->open;
  print $io->getlines;
  
=head1 DESCRIPTION

This meta-policy allows to store Moose object in glob reference or fil
+e
handle.  It allows to create a Moose version of F<IO::Handle>.

=cut


use constant attribute_metaclass => 'Moose::Policy::GlobRefObject::Met
+a::Attribute';


package Moose::Policy::GlobRefObject::Meta::Attribute;

use Moose;

extends 'Moose::Meta::Attribute';

use constant accessor_metaclass => 'Moose::Policy::GlobRefObject::Meta
+::Method::Accessor';


package Moose::Policy::GlobRefObject::Meta::Method::Accessor;

use Moose;

use Scalar::Util 'reftype';

extends 'Moose::Meta::Method::Accessor';

override '_inline_pre_body' => sub { 'local $_[0] = ${*{$_[0]}} if Sca
+lar::Util::reftype $_[0] eq \'GLOB\'; ' };


1;

__END__

=head1 AUTHORS

Piotr Roszatycki E<lt>dexter@debian.orgE<gt>

=head1 COPYRIGHT

Copyright 2006-2007 by Piotr Roszatycki E<lt>dexter@debian.orgE<gt>.

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

See L<http://www.perl.com/perl/misc/Artistic.html>
[download]

OMG... This is my first posting on PerlMonks :)

Comment on Moose object stored in globref Select or Download Code

Replies are listed 'Best First'.
Re: Moose object stored in globref by holli (Abbot) on Sep 01, 2007 at 15:19 UTC
OMG... This is my first posting on PerlMonks :) And so you shall be forgiven you posted into the wrong section. I have moved it here. Btw, welcome to the monastery. holli, /regexed monk/	[reply]