Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- package Link;
- sub FETCH {
- my $this = shift;
- return $this->{"site"};
- }
- sub STORE {
- my ($self,$site) = @_;
- $self->{"site"} = $site;
- }
- sub print_method {
- my $self = shift;
- print $self->{"site"};
- }
- sub TIESCALAR {
- my $class = shift;
- my $link = shift;
- my $this = {};
- bless($this,$class);
- $this->{"site"} = $link;
- return $this;
- }
- 1;
- use Link;
- tie my $var,"Link","http://somesite.com";
- $var->print_method;
- my $secret_object = tie my($normal_scalar), 'Tie::Class', @args;
- $secret_object->print_method;
- my $secret_object = tied $normal_scalar;
- package Link;
- use strict;
- use Carp;
- use overload
- (
- '""' => sub { shift->site },
- fallback => 1,
- );
- sub new
- {
- my $class = shift;
- my $self = bless {}, $class;
- if(@_)
- {
- if(@_ == 1)
- {
- $self->{'site'} = shift;
- }
- else { croak "$class->new() expects a single URL argument" }
- }
- return $self;
- }
- sub site
- {
- my $self = shift;
- $self->{'site'} = shift if(@_);
- return $self->{'site'};
- }
- sub print_method
- {
- my $self = shift;
- print $self->site, "n";
- }
- 1;
- use Link;
- my $link = Link->new('http://somesite.com');
- print $link, "n"; # http://somesite.com
- $link->print_method; # http://somesite.com
- package LinkTie;
- use strict;
- use Link;
- sub FETCH
- {
- my $this = shift;
- return $this->{'link'};
- }
- sub STORE
- {
- my($self, $site) = @_;
- $self->{'link'}->site($site);
- return $site;
- }
- # XXX: You could generalize this delegation with Class::Delegation or similar
- sub print_method
- {
- my $self = shift;
- print $self->{'link'}->print_method;
- }
- sub TIESCALAR
- {
- my $class = shift;
- my $self = bless {}, $class;
- $self->{'link'} = Link->new(@_);
- return $self;
- }
- 1;
- tie my $link,'LinkTie','http://somesite.com';
- print $link, "n"; # http://somesite.com
- $link->print_method; # http://somesite.com
- $link = 'http://othersite.com';
- print $link, "n"; # http://othersite.com
- $link->print_method; # http://othersite.com
Add Comment
Please, Sign In to add comment