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;

##</code><code>##

#!/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 file
handle.  It allows to create a Moose version of F<IO::Handle>.

=cut


use constant attribute_metaclass => 'Moose::Policy::GlobRefObject::Meta::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 Scalar::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 it
under the same terms as Perl itself.

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