overloading.pm 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. package overloading;
  2. use warnings;
  3. our $VERSION = '0.02';
  4. my $HINT_NO_AMAGIC = 0x01000000; # see perl.h
  5. require 5.010001;
  6. sub _ops_to_nums {
  7. require overload::numbers;
  8. map { exists $overload::numbers::names{"($_"}
  9. ? $overload::numbers::names{"($_"}
  10. : do { require Carp; Carp::croak("'$_' is not a valid overload") }
  11. } @_;
  12. }
  13. sub import {
  14. my ( $class, @ops ) = @_;
  15. if ( @ops ) {
  16. if ( $^H{overloading} ) {
  17. vec($^H{overloading} , $_, 1) = 0 for _ops_to_nums(@ops);
  18. }
  19. if ( $^H{overloading} !~ /[^\0]/ ) {
  20. delete $^H{overloading};
  21. $^H &= ~$HINT_NO_AMAGIC;
  22. }
  23. } else {
  24. delete $^H{overloading};
  25. $^H &= ~$HINT_NO_AMAGIC;
  26. }
  27. }
  28. sub unimport {
  29. my ( $class, @ops ) = @_;
  30. if ( exists $^H{overloading} or not $^H & $HINT_NO_AMAGIC ) {
  31. if ( @ops ) {
  32. vec($^H{overloading} ||= '', $_, 1) = 1 for _ops_to_nums(@ops);
  33. } else {
  34. delete $^H{overloading};
  35. }
  36. }
  37. $^H |= $HINT_NO_AMAGIC;
  38. }
  39. 1;
  40. __END__
  41. =head1 NAME
  42. overloading - perl pragma to lexically control overloading
  43. =head1 SYNOPSIS
  44. {
  45. no overloading;
  46. my $str = "$object"; # doesn't call stringification overload
  47. }
  48. # it's lexical, so this stringifies:
  49. warn "$object";
  50. # it can be enabled per op
  51. no overloading qw("");
  52. warn "$object";
  53. # and also reenabled
  54. use overloading;
  55. =head1 DESCRIPTION
  56. This pragma allows you to lexically disable or enable overloading.
  57. =over 6
  58. =item C<no overloading>
  59. Disables overloading entirely in the current lexical scope.
  60. =item C<no overloading @ops>
  61. Disables only specific overloads in the current lexical scope.
  62. =item C<use overloading>
  63. Reenables overloading in the current lexical scope.
  64. =item C<use overloading @ops>
  65. Reenables overloading only for specific ops in the current lexical scope.
  66. =back
  67. =cut