Don't recurse forever if both new() and TIESCALAR() are missing.

[perl5.git] / lib / Tie / Scalar.pm

diff --git a/lib/Tie/Scalar.pm b/lib/Tie/Scalar.pm
index 39480c8..329770a 100644 (file)
--- a/lib/Tie/Scalar.pm
+++ b/lib/Tie/Scalar.pm
@@ -1,6 +1,6 @@
 package Tie::Scalar;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 =head1 NAME
 
@@ -11,7 +11,7 @@ Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
     package NewScalar;
     require Tie::Scalar;
 
-    @ISA = (Tie::Scalar);
+    @ISA = qw(Tie::Scalar);
 
     sub FETCH { ... }          # Provide a needed method
     sub TIESCALAR { ... }      # Overrides inherited method
@@ -20,7 +20,7 @@ Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
     package NewStdScalar;
     require Tie::Scalar;
 
-    @ISA = (Tie::StdScalar);
+    @ISA = qw(Tie::StdScalar);
 
     # All methods provided by default, so define only what needs be overridden
     sub FETCH { ... }
@@ -47,7 +47,7 @@ For developers wishing to write their own tied-scalar classes, the methods
 are summarized below. The L<perltie> section not only documents these, but
 has sample code as well:
 
-=over
+=over 4
 
 =item TIESCALAR classname, LIST
 
@@ -73,6 +73,18 @@ destruction of an instance.
 
 =back
 
+=head2 Tie::Scalar vs Tie::StdScalar
+
+C<< Tie::Scalar >> provides all the necessary methods, but one should realize
+they do not do anything useful. Calling C<< Tie::Scalar::FETCH >> or 
+C<< Tie::Scalar::STORE >> results in a (trappable) croak. And if you inherit
+from C<< Tie::Scalar >>, you I<must> provide either a C<< new >> or a
+C<< TIESCALAR >> method. 
+
+If you are looking for a class that does everything for you you don't
+define yourself, use the C<< Tie::StdScalar >> class, not the
+C<< Tie::Scalar >> one.
+
 =head1 MORE INFORMATION
 
 The L<perltie> section uses a good example of tying scalars by associating
@@ -92,9 +104,20 @@ sub new {
 
 sub TIESCALAR {
     my $pkg = shift;
-    if (defined &{"{$pkg}::new"}) {
-       warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing");
-       $pkg->new(@_);
+    my $pkg_new = $pkg -> can ('new');
+
+    if ($pkg_new and $pkg ne __PACKAGE__) {
+        my $my_new = __PACKAGE__ -> can ('new');
+        if ($pkg_new == $my_new) {  
+            #
+            # Prevent recursion
+            #
+            croak "$pkg must define either a TIESCALAR() or a new() method";
+        }
+
+       warnings::warnif ("WARNING: calling ${pkg}->new since " .
+                          "${pkg}->TIESCALAR is missing");
+       $pkg -> new (@_);
     }
     else {
        croak "$pkg doesn't define a TIESCALAR method";
@@ -117,7 +140,7 @@ sub STORE {
 # tweak a small bit.
 #
 package Tie::StdScalar;
-@ISA = (Tie::Scalar);
+@ISA = qw(Tie::Scalar);
 
 sub TIESCALAR {
     my $class = shift;