code_junkie

How can I call methods on a tied variable

Nov 14th, 2011
219
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.95 KB | None | 0 0
  1. package Link;
  2.  
  3. sub FETCH {
  4. my $this = shift;
  5. return $this->{"site"};
  6. }
  7.  
  8. sub STORE {
  9. my ($self,$site) = @_;
  10. $self->{"site"} = $site;
  11. }
  12.  
  13. sub print_method {
  14. my $self = shift;
  15. print $self->{"site"};
  16. }
  17.  
  18. sub TIESCALAR {
  19. my $class = shift;
  20. my $link = shift;
  21. my $this = {};
  22. bless($this,$class);
  23. $this->{"site"} = $link;
  24. return $this;
  25. }
  26.  
  27. 1;
  28.  
  29. use Link;
  30.  
  31. tie my $var,"Link","http://somesite.com";
  32. $var->print_method;
  33.  
  34. my $secret_object = tie my($normal_scalar), 'Tie::Class', @args;
  35. $secret_object->print_method;
  36.  
  37. my $secret_object = tied $normal_scalar;
  38.  
  39. package Link;
  40.  
  41. use strict;
  42. use Carp;
  43.  
  44. use overload
  45. (
  46. '""' => sub { shift->site },
  47. fallback => 1,
  48. );
  49.  
  50. sub new
  51. {
  52. my $class = shift;
  53.  
  54. my $self = bless {}, $class;
  55.  
  56. if(@_)
  57. {
  58. if(@_ == 1)
  59. {
  60. $self->{'site'} = shift;
  61. }
  62. else { croak "$class->new() expects a single URL argument" }
  63. }
  64.  
  65. return $self;
  66. }
  67.  
  68. sub site
  69. {
  70. my $self = shift;
  71. $self->{'site'} = shift if(@_);
  72. return $self->{'site'};
  73. }
  74.  
  75. sub print_method
  76. {
  77. my $self = shift;
  78. print $self->site, "n";
  79. }
  80.  
  81. 1;
  82.  
  83. use Link;
  84.  
  85. my $link = Link->new('http://somesite.com');
  86.  
  87. print $link, "n"; # http://somesite.com
  88. $link->print_method; # http://somesite.com
  89.  
  90. package LinkTie;
  91.  
  92. use strict;
  93. use Link;
  94.  
  95. sub FETCH
  96. {
  97. my $this = shift;
  98. return $this->{'link'};
  99. }
  100.  
  101. sub STORE
  102. {
  103. my($self, $site) = @_;
  104. $self->{'link'}->site($site);
  105. return $site;
  106. }
  107.  
  108. # XXX: You could generalize this delegation with Class::Delegation or similar
  109. sub print_method
  110. {
  111. my $self = shift;
  112. print $self->{'link'}->print_method;
  113. }
  114.  
  115. sub TIESCALAR
  116. {
  117. my $class = shift;
  118. my $self = bless {}, $class;
  119. $self->{'link'} = Link->new(@_);
  120. return $self;
  121. }
  122.  
  123. 1;
  124.  
  125. tie my $link,'LinkTie','http://somesite.com';
  126. print $link, "n"; # http://somesite.com
  127. $link->print_method; # http://somesite.com
  128.  
  129. $link = 'http://othersite.com';
  130.  
  131. print $link, "n"; # http://othersite.com
  132. $link->print_method; # http://othersite.com
Add Comment
Please, Sign In to add comment