Using Scalar Ties with Moose!

lab_main.pl

#!/usr/bin/perl -s
use strict;
use warnings;

use CGI;
use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;

use Lab::ScalarTie_Lab;

=pod 
==============================================================================
    Main
==============================================================================
=cut

$| = 1;
$, = " ";

	my $cgi = CGI->new();
	
        #print headers here to get rid of the 500 for web output
        print $cgi->header('text/html');

	my $lab = Lab::ScalarTie_Lab->new( "string" => "<span style='color:red'>This is my string from new!</span>" );
		
	my $ios = $lab->ioscalar();
	print $ios "<span style='color:blue'>This is a newly added String!</span>";
	print $ios "Can you do that again please?";
	print $lab->string();


  print "<pre>",$cgi->escapeHTML( Dumper( $lab )) ,"</pre>";  
  print "<pre>",$cgi->escapeHTML( Dumper( $lab->ioscalar() )) ,"</pre>";      



exit;

1;
__END__

Lab_Moosy_ScalarTies.pm

=pod 
==============================================================================
 @nodebunny

==============================================================================
=cut

package Lab::ScalarTie_Lab;

use Moose;
use namespace::autoclean;
use IO::Scalar;

our $_STRING = "_STARTER TEXT_";
  

has 'string_ref' => ( is => 'rw', isa => 'ScalarRef' ); 

has 'string' => ( is => 'rw', isa => 'Str', 
                  trigger => sub{ 
                    my($self,$str,$old_str) = @_; 
                    $self->string_buffer($str);
                    #not using $old_str anywhere
                  });
  
has 'ioscalar' => ( 
    is      => 'rw', 
    isa     => 'Maybe[IO::Scalar]',
    default => sub{ return IO::Scalar->new( \$_STRING ) },

);    	
	
=pod 
==============================================================================
     Core
==============================================================================
=cut  

  sub BUILD{
    my($self) = @_; 
    $self->string_ref(\$_STRING);   
  }
  
=pod 
==============================================================================
     String Buffer
==============================================================================
=cut
  
  around 'string' => sub{
    my($orig,$self,$string) = @_;    	
    	return $_STRING unless $string;
    	$self->string_buffer($string);  		
    	return $self->$orig($_STRING);		
  };
  
  sub string_buffer{
    my($self,$str) = @_; 
    my $ios = $self->ioscalar();
    print $ios $str;
  }

END{
   print STDERR ("UNLOADED! ".__PACKAGE__);
}

 __PACKAGE__->meta->make_immutable;


1;
__END__