The magic signatures are no longer needed

[perl/modules/Variable-Magic.git] / lib / Variable / Magic.pm

diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index 40df3be547d8a62b2ea6d65c22f6927091cb35cc..01b1c7069223a53b2597aaf91cd542f71623832e 100644 (file)
--- a/lib/Variable/Magic.pm
+++ b/lib/Variable/Magic.pm
@@ -11,22 +11,24 @@ Variable::Magic - Associate user-defined magic to variables from Perl.
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-Version 0.44
+Version 0.46

 
 =cut
 
 our $VERSION;
 BEGIN {
 
 =cut
 
 our $VERSION;
 BEGIN {

- $VERSION = '0.44';
+ $VERSION = '0.46';

 }
 
 =head1 SYNOPSIS
 
 }
 
 =head1 SYNOPSIS
 

-    use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/;
+    use Variable::Magic qw<wizard cast VMG_OP_INFO_NAME>;

 
     { # A variable tracer
 
     { # A variable tracer

-     my $wiz = wizard set  => sub { print "now set to ${$_[0]}!\n" },
-                      free => sub { print "destroyed!\n" };
+     my $wiz = wizard(
+      set  => sub { print "now set to ${$_[0]}!\n" },
+      free => sub { print "destroyed!\n" },
+     );

 
      my $a = 1;
      cast $a, $wiz;
 
      my $a = 1;
      cast $a, $wiz;


@@ -34,15 +36,17 @@ BEGIN {
     }               # "destroyed!"
 
     { # A hash with a default value
     }               # "destroyed!"
 
     { # A hash with a default value

-     my $wiz = wizard data     => sub { $_[1] },
-                      fetch    => sub { $_[2] = $_[1] unless exists $_[0]->{$_[2]}; () },
-                      store    => sub { print "key $_[2] stored in $_[-1]\n" },
-                      copy_key => 1,
-                      op_info  => VMG_OP_INFO_NAME;
+     my $wiz = wizard(
+      data     => sub { $_[1] },
+      fetch    => sub { $_[2] = $_[1] unless exists $_[0]->{$_[2]}; () },
+      store    => sub { print "key $_[2] stored in $_[-1]\n" },
+      copy_key => 1,
+      op_info  => VMG_OP_INFO_NAME,
+     );

 
      my %h = (_default => 0, apple => 2);
      cast %h, $wiz, '_default';
 
      my %h = (_default => 0, apple => 2);
      cast %h, $wiz, '_default';

-     print $h{banana}, "\n"; # "0", because the 'banana' key doesn't exist in %h
+     print $h{banana}, "\n"; # "0" (there is no 'banana' key in %h)

      $h{pear} = 1;           # "key pear stored in helem"
     }
 
      $h{pear} = 1;           # "key pear stored in helem"
     }
 


@@ -192,9 +196,6 @@ This last one triggers when a key is deleted in the hash, regardless of whether
 
 You can refer to the tests to have more insight of where the different magics are invoked.
 
 
 You can refer to the tests to have more insight of where the different magics are invoked.
 

-To prevent any clash between different magics defined with this module, an unique numerical signature is attached to each kind of magic (i.e. each set of callbacks for magic operations).
-At the C level, magic tokens owned by magic created by this module have their C<< mg->mg_private >> field set to C<0x3891> or C<0x3892>, so please don't use these magic (sic) numbers in other extensions.
-

 =head1 FUNCTIONS
 
 =cut
 =head1 FUNCTIONS
 
 =cut


@@ -206,20 +207,24 @@ BEGIN {
 
 =head2 C<wizard>
 
 
 =head2 C<wizard>
 

-    wizard data     => sub { ... },
-           get      => sub { my ($ref, $data [, $op]) = @_; ... },
-           set      => sub { my ($ref, $data [, $op]) = @_; ... },
-           len      => sub { my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen; },
-           clear    => sub { my ($ref, $data [, $op]) = @_; ... },
-           free     => sub { my ($ref, $data [, $op]) = @_, ... },
-           copy     => sub { my ($ref, $data, $key, $elt [, $op]) = @_; ... },
-           local    => sub { my ($ref, $data [, $op]) = @_; ... },
-           fetch    => sub { my ($ref, $data, $key [, $op]) = @_; ... },
-           store    => sub { my ($ref, $data, $key [, $op]) = @_; ... },
-           exists   => sub { my ($ref, $data, $key [, $op]) = @_; ... },
-           delete   => sub { my ($ref, $data, $key [, $op]) = @_; ... },
-           copy_key => $bool,
-           op_info  => [ 0 | VMG_OP_INFO_NAME | VMG_OP_INFO_OBJECT ]
+    wizard(
+     data     => sub { ... },
+     get      => sub { my ($ref, $data [, $op]) = @_; ... },
+     set      => sub { my ($ref, $data [, $op]) = @_; ... },
+     len      => sub {
+      my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen
+     },
+     clear    => sub { my ($ref, $data [, $op]) = @_; ... },
+     free     => sub { my ($ref, $data [, $op]) = @_, ... },
+     copy     => sub { my ($ref, $data, $key, $elt [, $op]) = @_; ... },
+     local    => sub { my ($ref, $data [, $op]) = @_; ... },
+     fetch    => sub { my ($ref, $data, $key [, $op]) = @_; ... },
+     store    => sub { my ($ref, $data, $key [, $op]) = @_; ... },
+     exists   => sub { my ($ref, $data, $key [, $op]) = @_; ... },
+     delete   => sub { my ($ref, $data, $key [, $op]) = @_; ... },
+     copy_key => $bool,
+     op_info  => [ 0 | VMG_OP_INFO_NAME | VMG_OP_INFO_OBJECT ],
+    )

 
 This function creates a 'wizard', an opaque type that holds the magic information.
 It takes a list of keys / values as argument, whose keys can be :
 
 This function creates a 'wizard', an opaque type that holds the magic information.
 It takes a list of keys / values as argument, whose keys can be :


@@ -287,9 +292,11 @@ Note that C<free> callbacks are I<never> called during global destruction, as th
 Here's a simple usage example :
 
     # A simple scalar tracer
 Here's a simple usage example :
 
     # A simple scalar tracer

-    my $wiz = wizard get  => sub { print STDERR "got ${$_[0]}\n" },
-                     set  => sub { print STDERR "set to ${$_[0]}\n" },
-                     free => sub { print STDERR "${$_[0]} was deleted\n" }
+    my $wiz = wizard(
+     get  => sub { print STDERR "got ${$_[0]}\n" },
+     set  => sub { print STDERR "set to ${$_[0]}\n" },
+     free => sub { print STDERR "${$_[0]} was deleted\n" },
+    );

 
 =cut
 
 
 =cut
 


@@ -301,11 +308,9 @@ sub wizard {
 
  my %opts = @_;
 
 
  my %opts = @_;
 

- my @keys = qw/data op_info get set len clear free/;
- push @keys, 'copy'  if MGf_COPY;
- push @keys, 'dup'   if MGf_DUP;
+ my @keys = qw<op_info data get set len clear free copy dup>;

  push @keys, 'local' if MGf_LOCAL;
  push @keys, 'local' if MGf_LOCAL;

- push @keys, qw/fetch store exists delete copy_key/ if VMG_UVAR;
+ push @keys, qw<fetch store exists delete copy_key> if VMG_UVAR;

 
  my ($wiz, $err);
  {
 
  my ($wiz, $err);
  {


@@ -440,7 +445,7 @@ It is similar to using inside-out objects, but without the drawback of having to
     {
      package Magical::UserData;
 
     {
      package Magical::UserData;
 

-     use Variable::Magic qw/wizard cast getdata/;
+     use Variable::Magic qw<wizard cast getdata>;

 
      my $wiz = wizard data => sub { \$_[1] };
 
 
      my $wiz = wizard data => sub { \$_[1] };
 


@@ -450,7 +455,7 @@ It is similar to using inside-out objects, but without the drawback of having to
       unless (defined $data) {
        $data = \(my $slot);
        &cast($var, $wiz, $slot)
       unless (defined $data) {
        $data = \(my $slot);
        &cast($var, $wiz, $slot)

-                        or die "Couldn't cast UserData magic onto the variable";
+                 or die "Couldn't cast UserData magic onto the variable";

       }
       $$data;
      }
       }
       $$data;
      }


@@ -575,12 +580,12 @@ All the constants are also only exported on request, either individually or by t
 
 =cut
 
 
 =cut
 

-use base qw/Exporter/;
+use base qw<Exporter>;

 
 our @EXPORT         = ();
 our %EXPORT_TAGS    = (
 
 our @EXPORT         = ();
 our %EXPORT_TAGS    = (

- 'funcs' =>  [ qw/wizard cast getdata dispell/ ],
- 'consts' => [ qw/
+ 'funcs' =>  [ qw<wizard cast getdata dispell> ],
+ 'consts' => [ qw<

    MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR
    VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
    VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID
    MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR
    VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
    VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID


@@ -590,7 +595,7 @@ our %EXPORT_TAGS    = (
    VMG_PERL_PATCHLEVEL
    VMG_THREADSAFE VMG_FORKSAFE
    VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT
    VMG_PERL_PATCHLEVEL
    VMG_THREADSAFE VMG_FORKSAFE
    VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT

- / ],
+ > ],

 );
 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 );
 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];


@@ -647,7 +652,7 @@ Tests code coverage report is available at L<http://www.profvince.com/perl/cover
 
 =head1 COPYRIGHT & LICENSE
 
 
 =head1 COPYRIGHT & LICENSE
 

-Copyright 2007,2008,2009,2010 Vincent Pit, all rights reserved.
+Copyright 2007,2008,2009,2010,2011 Vincent Pit, all rights reserved.

 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.