X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Foverload.pm;h=da114c505e0d87e5ccbfb62f5ad4e39c6e46eea6;hb=55b6781562aff32ef6499c4f263ab251254ca5cb;hp=5faaad33ab8172e0417ab31ad402bc5c0082ce25;hpb=05a4b9b1cf732bd593a66695e9160c88fe43217c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/overload.pm b/lib/overload.pm index 5faaad3..da114c5 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -1,6 +1,6 @@ package overload; -our $VERSION = '1.06'; +our $VERSION = '1.07'; sub nil {} @@ -73,6 +73,8 @@ sub OverloadedStringify { sub Method { my $package = shift; if(ref $package) { + local $@; + local $!; require Scalar::Util; $package = Scalar::Util::blessed($package); return undef if !defined $package; @@ -87,12 +89,14 @@ sub AddrRef { my $package = ref $_[0]; return "$_[0]" unless $package; - require Scalar::Util; - my $class = Scalar::Util::blessed($_[0]); - 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); + local $@; + local $!; + require Scalar::Util; + my $class = Scalar::Util::blessed($_[0]); + 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); } *StrVal = *AddrRef; @@ -100,6 +104,10 @@ sub AddrRef { sub mycan { # Real can would leave stubs. my ($package, $meth) = @_; + local $@; + local $!; + require mro; + my $mro = mro::get_linear_isa($package); foreach my $p (@$mro) { my $fqmeth = $p . q{::} . $meth; @@ -128,6 +136,7 @@ sub mycan { # Real can would leave stubs. func => "atan2 cos sin exp abs log sqrt int", conversion => 'bool "" 0+', iterators => '<>', + filetest => "-X", dereferencing => '${} @{} %{} &{} *{}', special => 'nomethod fallback ='); @@ -142,7 +151,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 above as code references can be # blessed, and C would return the package the ref is blessed into. if (warnings::enabled) { @@ -186,7 +195,7 @@ overload - Package for overloading Perl operations ... package main; - $a = new SomeThing 57; + $a = SomeThing->new( 57 ); $b=5+$a; ... if (overload::Overloaded $b) {...} @@ -195,6 +204,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 instead. + =head2 Declaration of overloaded functions The compilation directive @@ -413,6 +425,29 @@ I syntax C${var}E>. B Even in list context, the iterator is currently called only once and with scalar context. +=item * I + + "-X" + +This overload is used for all the filetest operators (C<-f>, C<-x> and +so on: see L 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, C 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 '${}', '@{}', '%{}', '&{}', '*{}'. @@ -452,6 +487,7 @@ A computer-readable form of the above table is available in the hash func => 'atan2 cos sin exp abs log sqrt', conversion => 'bool "" 0+', iterators => '<>', + filetest => '-X', dereferencing => '${} @{} %{} &{} *{}', special => 'nomethod fallback =' @@ -584,7 +620,8 @@ appear as lvalue when the above code is executed. If the copy constructor is required during the execution of some mutator, but a method for C<'='> was not specified, it can be autogenerated as a -string copy if the object is a plain scalar. +string copy if the object is a plain scalar or a simple assignment if it +is not. =over 5 @@ -671,7 +708,8 @@ C=E> or C: =item I can be expressed in terms of an assignment to the dereferenced value, if this -value is a scalar and not a reference. +value is a scalar and not a reference, or simply a reference assignment +otherwise. =back @@ -892,7 +930,7 @@ If some mutator methods are directly applied to the overloaded values, one may need to I other values which references the same value: - $a = new Data 23; + $a = Data->new(23); ... $b = $a; # $b is "linked" to $a ... @@ -901,13 +939,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 a way to make assignments @@ -937,7 +975,7 @@ Put this in F 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/; @@ -984,7 +1022,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'; @@ -1089,15 +1127,15 @@ This module is very unusual as overloaded modules go: it does not provide any usual overloaded operators, instead it provides the L operator C. In this example the corresponding subroutine returns an object which encapsulates operations done over -the objects: C 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--) { @@ -1221,8 +1259,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) { @@ -1342,8 +1380,8 @@ To see it in action, add a method to the package C. 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 @@ -1392,6 +1430,11 @@ and $b. Ilya Zakharevich EFE. +=head1 SEE ALSO + +The L pragma can be used to enable or disable overloaded +operations within a lexical scope. + =head1 DIAGNOSTICS When Perl is run with the B<-Do> switch or its equivalent, overloading