view release on metacpan or  search on metacpan

basiclib/overload.pm-txt  view on Meta::CPAN

sub StrVal {
  (OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ?
    (AddrRef(shift)) :
    "$_[0]";
}

sub mycan {				# Real can would leave stubs.
  my ($package, $meth) = @_;
  return \*{$package . "::$meth"} if defined &{$package . "::$meth"};
  my $p;
  foreach $p (@{$package . "::ISA"}) {
    my $out = mycan($p, $meth);
    return $out if $out;
  }
  return undef;
}

%constants = (
	      'integer'	  =>  0x1000,
	      'float'	  =>  0x2000,
	      'binary'	  =>  0x4000,
	      'q'	  =>  0x8000,
	      'qr'	  => 0x10000,
	     );

%ops = ( with_assign	  => "+ - * / % ** << >> x .",
	 assign		  => "+= -= *= /= %= **= <<= >>= x= .=",
	 num_comparison	  => "< <= >  >= == !=",
	 '3way_comparison'=> "<=> cmp",
	 str_comparison	  => "lt le gt ge eq ne",
	 binary		  => "& | ^",
	 unary		  => "neg ! ~",
	 mutators	  => '++ --',
	 func		  => "atan2 cos sin exp abs log sqrt",
	 conversion	  => 'bool "" 0+',
	 iterators	  => '<>',
	 dereferencing	  => '${} @{} %{} &{} *{}',
	 special	  => 'nomethod fallback =');

use warnings::register;
sub constant {
  # Arguments: what, sub
  while (@_) {
    if (@_ == 1) {
        warnings::warnif ("Odd number of arguments for overload::constant");
        last;
    }
    elsif (!exists $constants {$_ [0]}) {
        warnings::warnif ("`$_[0]' is not an overloadable type");
    }
    elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-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) {
            $_ [1] = "undef" unless defined $_ [1];
            warnings::warn ("`$_[1]' is not a code reference");
        }
    }
    else {
        $^H{$_[0]} = $_[1];
        $^H |= $constants{$_[0]} | $overload::hint_bits;
    }
    shift, shift;
  }
}

sub remove_constant {
  # Arguments: what, sub
  while (@_) {
    delete $^H{$_[0]};
    $^H &= ~ $constants{$_[0]};
    shift, shift;
  }
}

1;

__END__

=head1 NAME

overload - Package for overloading perl operations

=head1 SYNOPSIS

    package SomeThing;

    use overload
	'+' => \&myadd,
	'-' => \&mysub;
	# etc
    ...

    package main;
    $a = new SomeThing 57;
    $b=5+$a;
    ...
    if (overload::Overloaded $b) {...}
    ...
    $strval = overload::StrVal $b;

=head1 DESCRIPTION

=head2 Declaration of overloaded functions

The compilation directive

    package Number;
    use overload
	"+" => \&add,
	"*=" => "muas";

declares function Number::add() for addition, and method muas() in
the "class" C<Number> (or one of its base classes)
for the assignment form C<*=> of multiplication.

Arguments of this directive come in (key, value) pairs.  Legal values
are values legal inside a C<&{ ... }> call, so the name of a
subroutine, a reference to a subroutine, or an anonymous subroutine
will all work.  Note that values specified as strings are
interpreted as methods, not subroutines.  Legal keys are listed below.

The subroutine C<add> will be called to execute C<$a+$b> if $a
is a reference to an object blessed into the package C<Number>, or if $a is
not an object from a package with defined mathemagic addition, but $b is a
reference to a C<Number>.  It can also be called in other situations, like
C<$a+=7>, or C<$a++>.  See L<MAGIC AUTOGENERATION>.  (Mathemagical
methods refer to methods triggered by an overloaded mathematical
operator.)

Since overloading respects inheritance via the @ISA hierarchy, the