view release on metacpan or  search on metacpan

lib/Perlito5X/overload.pm  view on Meta::CPAN

    return undef if !defined $package;
  }
  #my $meth = $package->can('(' . shift);
  ov_method mycan($package, '(' . shift), $package;
  #return $meth if $meth ne \&nil;
  #return $ {*{$meth}};
}

sub AddrRef {
  no overloading;
  "$_[0]";
}

*StrVal = *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;
    return \*{$fqmeth} if defined &{$fqmeth};
  }

  return undef;
}

%constants = (
	      'integer'	  =>  0x1000, # HINT_NEW_INTEGER
	      'float'	  =>  0x2000, # HINT_NEW_FLOAT
	      'binary'	  =>  0x4000, # HINT_NEW_BINARY
	      'q'	  =>  0x8000, # HINT_NEW_STRING
	      'qr'	  => 0x10000, # HINT_NEW_RE
	     );

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[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) {
            $_ [1] = "undef" unless defined $_ [1];
            warnings::warn ("'$_[1]' is not a code reference");
        }
    }
    else {
        $^H{$_[0]} = $_[1];
        $^H |= $constants{$_[0]};
    }
    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 = SomeThing->new( 57 );
    $b = 5 + $a;
    ...
    if (overload::Overloaded $b) {...}
    ...
    $strval = overload::StrVal $b;

=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 Fundamentals

=head3 Declaration

Arguments of the C<use overload> directive are (key, value) pairs.
For the full set of legal keys, see L<Overloadable Operations> below.

Operator implementations (the values) can be subroutines,
references to subroutines, or anonymous subroutines
- in other words, anything legal inside a C<&{ ... }> call.
Values specified as strings are interpreted as method names.
Thus

    package Number;
    use overload
        "-" => "minus",
        "*=" => \&muas,
        '""' => sub { ...; };

declares that subtraction is to be implemented by method C<minus()>
in the class C<Number> (or one of its base classes),
and that the function C<Number::muas()> is to be used for the
assignment form of multiplication, C<*=>.
It also defines an anonymous subroutine to implement stringification:
this is called whenever an object blessed into the package C<Number>