/usr/share/perl5/Tie/ToObject.pm is in libtie-toobject-perl 0.03-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | #!/usr/bin/perl
package Tie::ToObject;
use strict;
#use warnings;
use vars qw($VERSION $AUTOLOAD);
use Carp qw(croak);
use Scalar::Util qw(blessed);
$VERSION = "0.03";
sub AUTOLOAD {
my ( $self, $tied ) = @_;
my ( $method ) = ( $AUTOLOAD =~ /([^:]+)$/ );
if ( $method =~ /^TIE/ ) {
if ( blessed($tied) ) {
return $tied;
} else {
croak "You must supply an object as the argument to tie()";
}
} else {
croak "Unsupported method for $method, this module is only for tying to existing objects";
}
}
__PACKAGE__
__END__
=pod
=head1 NAME
Tie::ToObject - Tie to an existing object.
=head1 SYNOPSIS
use Tie::ToObject;
my $stolen = tied(%something);
tie %something_else, 'Tie::ToObject', $stolen;
=head1 DESCRIPTION
While L<perldoc/tie> allows tying to an arbitrary object, the class in question
must support this in it's implementation of C<TIEHASH>, C<TIEARRAY> or
whatever.
This class provides a very tie constructor that simply returns the object it
was given as it's first argument.
This way side effects of calling C<< $object->TIEHASH >> are avoided.
This is used in L<Data::Visitor> in order to tie a variable to an already
existing object. This is also useful for cloning, when you want to clone the
internal state object instead of going through the tie interface for that
variable.
=head1 VERSION CONTROL
This module is maintained using Darcs. You can get the latest version from
L<http://nothingmuch.woobling.org/code>, and use C<darcs send> to commit
changes.
=head1 AUTHOR
Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
=head1 COPYRIGHT
Copyright (c) 2008 Yuval Kogman. All rights reserved
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=cut
|