This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #79680] overload 1.10 sprintf fails taint checking
[perl5.git] / lib / overload.pm
index 4d1d375..dbc3de6 100644 (file)
@@ -1,6 +1,6 @@
 package overload;
 
-our $VERSION = '1.07';
+our $VERSION = '1.11';
 
 sub nil {}
 
@@ -9,6 +9,7 @@ sub OVERLOAD {
   my %arg = @_;
   my ($sub, $fb);
   $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
+  $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
   *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
   for (keys %arg) {
     if ($_ eq 'fallback') {
@@ -56,7 +57,9 @@ sub ov_method {
   my $globref = shift;
   return undef unless $globref;
   my $sub = \&{*$globref};
-  return $sub if $sub ne \&nil;
+  require Scalar::Util;
+  return $sub
+    if Scalar::Util::refaddr($sub) != Scalar::Util::refaddr(\&nil);
   return shift->can($ {*$globref});
 }
 
@@ -96,7 +99,7 @@ sub AddrRef {
   my $class_prefix = defined($class) ? "$class=" : "";
   my $type = Scalar::Util::reftype($_[0]);
   my $addr = Scalar::Util::refaddr($_[0]);
-  return sprintf("$class_prefix$type(0x%x)", $addr);
+  return sprintf("%s%s(0x%x)", $class_prefix, $type, $addr);
 }
 
 *StrVal = *AddrRef;
@@ -134,9 +137,11 @@ sub mycan {                                # Real can would leave stubs.
         unary            => "neg ! ~",
         mutators         => '++ --',
         func             => "atan2 cos sin exp abs log sqrt int",
-        conversion       => 'bool "" 0+',
+        conversion       => 'bool "" 0+ qr',
         iterators        => '<>',
+         filetest         => "-X",
         dereferencing    => '${} @{} %{} &{} *{}',
+        matching         => '~~',
         special          => 'nomethod fallback =');
 
 use warnings::register;
@@ -150,7 +155,7 @@ sub constant {
     elsif (!exists $constants {$_ [0]}) {
         warnings::warnif ("`$_[0]' is not an overloadable type");
     }
-    elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) {
+    elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) {
         # Can't use C<ref $_[1] eq "CODE"> above as code references can be
         # blessed, and C<ref> would return the package the ref is blessed into.
         if (warnings::enabled) {
@@ -194,7 +199,7 @@ overload - Package for overloading Perl operations
     ...
 
     package main;
-    $a = new SomeThing 57;
+    $a = SomeThing->new( 57 );
     $b=5+$a;
     ...
     if (overload::Overloaded $b) {...}
@@ -203,6 +208,9 @@ overload - Package for overloading Perl operations
 
 =head1 DESCRIPTION
 
+This pragma allows overloading of Perl's operators for a class.
+To overload built-in functions, see L<perlsub/Overriding Built-in Functions> instead.
+
 =head2 Declaration of overloaded functions
 
 The compilation directive
@@ -394,15 +402,20 @@ floating-point-like types one should follow the same semantic.  If
 C<int> is unavailable, it can be autogenerated using the overloading of
 C<0+>.
 
-=item * I<Boolean, string and numeric conversion>
+=item * I<Boolean, string, numeric and regexp conversions>
+
+    'bool', '""', '0+', 'qr'
 
-    'bool', '""', '0+',
+If one or two of these operations are not overloaded, the remaining ones
+can be used instead.  C<bool> is used in the flow control operators
+(like C<while>) and for the ternary C<?:> operation; C<qr> is used for
+the RHS of C<=~> and when an object is interpolated into a regexp.
 
-If one or two of these operations are not overloaded, the remaining ones can
-be used instead.  C<bool> is used in the flow control operators
-(like C<while>) and for the ternary C<?:> operation.  These functions can
-return any arbitrary Perl value.  If the corresponding operation for this value
-is overloaded too, that operation will be called again with this value.
+C<bool>, C<"">, and C<0+> can return any arbitrary Perl value.  If the
+corresponding operation for this value is overloaded too, that operation
+will be called again with this value. C<qr> must return a compiled
+regexp, or a ref to a compiled regexp (such as C<qr//> returns), and any
+further overloading on the return value will be ignored.
 
 As a special case if the overload returns the object itself then it will
 be used directly. An overloaded conversion returning the object is
@@ -421,6 +434,60 @@ I<globbing> syntax C<E<lt>${var}E<gt>>.
 B<BUGS> Even in list context, the iterator is currently called only
 once and with scalar context.
 
+=item * I<File tests>
+
+    "-X"
+
+This overload is used for all the filetest operators (C<-f>, C<-x> and
+so on: see L<perlfunc/-X> for the full list). Even though these are
+unary operators, the method will be called with a second argument which
+is a single letter indicating which test was performed. Note that the
+overload key is the literal string C<"-X">: you can't provide separate
+overloads for the different tests.
+
+Calling an overloaded filetest operator does not affect the stat value
+associated with the special filehandle C<_>. It still refers to the
+result of the last C<stat>, C<lstat> or unoverloaded filetest.
+
+If not overloaded, these operators will fall back to the default
+behaviour even without C<< fallback => 1 >>. This means that if the
+object is a blessed glob or blessed IO ref it will be treated as a
+filehandle, otherwise string overloading will be invoked and the result
+treated as a filename.
+
+This overload was introduced in perl 5.12.
+
+=item * I<Matching>
+
+The key C<"~~"> allows you to override the smart matching logic used by
+the C<~~> operator and the switch construct (C<given>/C<when>).  See
+L<perlsyn/switch> and L<feature>.
+
+Unusually, overloading of the smart match operator does not automatically
+take precedence over normal smart match behaviour. In particular, in the
+following code:
+
+    package Foo;
+    use overload '~~' => 'match';
+
+    my $obj =  Foo->new();
+    $obj ~~ [ 1,2,3 ];
+
+the smart match does I<not> invoke the method call like this:
+
+    $obj->match([1,2,3],0);
+
+rather, the smart match distributive rule takes precedence, so $obj is
+smart matched against each array element in turn until a match is found,
+so you may see between one and three of these calls instead:
+
+    $obj->match(1,0);
+    $obj->match(2,0);
+    $obj->match(3,0);
+
+Consult the match table in  L<perlsyn/"Smart matching in detail"> for
+details of when overloading is invoked.
+
 =item * I<Dereferencing>
 
     '${}', '@{}', '%{}', '&{}', '*{}'.
@@ -437,7 +504,7 @@ The dereference operators must be specified explicitly they will not be passed t
 
 =item * I<Special>
 
-    "nomethod", "fallback", "=", "~~",
+    "nomethod", "fallback", "=".
 
 see L<SPECIAL SYMBOLS FOR C<use overload>>.
 
@@ -458,9 +525,11 @@ A computer-readable form of the above table is available in the hash
  unary           => 'neg ! ~',
  mutators        => '++ --',
  func            => 'atan2 cos sin exp abs log sqrt',
- conversion      => 'bool "" 0+',
+ conversion      => 'bool "" 0+ qr',
  iterators       => '<>',
+ filetest         => '-X',
  dereferencing   => '${} @{} %{} &{} *{}',
+ matching        => '~~',
  special         => 'nomethod fallback ='
 
 =head2 Inheritance and overloading
@@ -557,11 +626,6 @@ C<"nomethod"> value, and if this is missing, raises an exception.
 B<Note.> C<"fallback"> inheritance via @ISA is not carved in stone
 yet, see L<"Inheritance and overloading">.
 
-=head2 Smart Match
-
-The key C<"~~"> allows you to override the smart matching used by
-the switch construct. See L<feature>.
-
 =head2 Copy Constructor
 
 The value for C<"="> is a reference to a function with three
@@ -636,8 +700,8 @@ is not defined.
 
 =item I<Conversion operations>
 
-String, numeric, and boolean conversion are calculated in terms of one
-another if not all of them are defined.
+String, numeric, boolean and regexp conversions are calculated in terms
+of one another if not all of them are defined.
 
 =item I<Increment and decrement>
 
@@ -902,7 +966,7 @@ If some mutator methods are directly applied to the overloaded values,
 one may need to I<explicitly unlink> other values which references the
 same value:
 
-    $a = new Data 23;
+    $a = Data->new(23);
     ...
     $b = $a;           # $b is "linked" to $a
     ...
@@ -911,13 +975,13 @@ same value:
 
 Note that overloaded access makes this transparent:
 
-    $a = new Data 23;
+    $a = Data->new(23);
     $b = $a;           # $b is "linked" to $a
     $a += 4;           # would unlink $b automagically
 
 However, it would not make
 
-    $a = new Data 23;
+    $a = Data->new(23);
     $a = 4;            # Now $a is a plain 4, not 'Data'
 
 preserve "objectness" of $a.  But Perl I<has> a way to make assignments
@@ -947,7 +1011,7 @@ Put this in F<two_face.pm> in your Perl library directory:
 Use it as follows:
 
   require two_face;
-  my $seven = new two_face ("vii", 7);
+  my $seven = two_face->new("vii", 7);
   printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
   print "seven contains `i'\n" if $seven =~ /i/;
 
@@ -994,7 +1058,7 @@ array reference and a hash reference.
 
 Now one can access an object using both the array and hash syntax:
 
-  my $bar = new two_refs 3,4,5,6;
+  my $bar = two_refs->new(3,4,5,6);
   $bar->[2] = 11;
   $bar->{two} == 11 or die 'bad hash fetch';
 
@@ -1099,15 +1163,15 @@ This module is very unusual as overloaded modules go: it does not
 provide any usual overloaded operators, instead it provides the L<Last
 Resort> operator C<nomethod>.  In this example the corresponding
 subroutine returns an object which encapsulates operations done over
-the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
-symbolic 3> contains C<['+', 2, ['n', 3]]>.
+the objects: C<< symbolic->new(3) >> contains C<['n', 3]>, C<< 2 +
+symbolic->new(3) >> contains C<['+', 2, ['n', 3]]>.
 
 Here is an example of the script which "calculates" the side of
 circumscribed octagon using the above package:
 
   require symbolic;
   my $iter = 1;                        # 2**($iter+2) = 8
-  my $side = new symbolic 1;
+  my $side = symbolic->new(1);
   my $cnt = $iter;
 
   while ($cnt--) {
@@ -1231,8 +1295,8 @@ explicit recursion in num()?  (Answer is at the end of this section.)
 Use this module like this:
 
   require symbolic;
-  my $iter = new symbolic 2;   # 16-gon
-  my $side = new symbolic 1;
+  my $iter = symbolic->new(2); # 16-gon
+  my $side = symbolic->new(1);
   my $cnt = $iter;
 
   while ($cnt) {
@@ -1352,8 +1416,8 @@ To see it in action, add a method
 
 to the package C<symbolic>.  After this change one can do
 
-  my $a = new symbolic 3;
-  my $b = new symbolic 4;
+  my $a = symbolic->new(3);
+  my $b = symbolic->new(4);
   my $c = sqrt($a**2 + $b**2);
 
 and the numeric value of $c becomes 5.  However, after calling