home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _0e23318765a879a41edde36d9dae2287 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.5 KB  |  51 lines
  1. $DB::single = 1;
  2.  
  3. package Demo;
  4. $VERSION = '1.00';
  5. use Attribute::Handlers;
  6. no warnings 'redefine';
  7.  
  8. sub Demo : ATTR(SCALAR) {
  9.     my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
  10.     $data = '<undef>' unless defined $data;
  11.     print STDERR 'Scalar $', *{$symbol}{NAME},
  12.              " ($referent) was ascribed ${attr}\n",
  13.              "with data ($data)\nin phase $phase\n";
  14. };
  15.  
  16. sub This : ATTR(SCALAR) {
  17.     print STDERR "This at ",
  18.              join(":", map { defined() ? $_ : "" } caller(1)),
  19.              "\n";
  20. }
  21.  
  22. sub Demo : ATTR(HASH) {
  23.     my ($package, $symbol, $referent, $attr, $data) = @_;
  24.     $data = '<undef>' unless defined $data;
  25.     print STDERR 'Hash %', *{$symbol}{NAME},
  26.              " ($referent) was ascribed ${attr} with data ($data)\n";
  27. };
  28.  
  29. sub Demo : ATTR(CODE) {
  30.     my ($package, $symbol, $referent, $attr, $data) = @_;
  31.     $data = '<undef>' unless defined $data;
  32.     print STDERR 'Sub &', *{$symbol}{NAME},
  33.              " ($referent) was ascribed ${attr} with data ($data)\n";
  34. };
  35.  
  36. sub Multi : ATTR {
  37.     my ($package, $symbol, $referent, $attr, $data) = @_;
  38.     $data = '<undef>' unless defined $data;
  39.     print STDERR ref($referent), ' ', *{$symbol}{NAME},
  40.              " ($referent) was ascribed ${attr} with data ($data)\n";
  41. };
  42.  
  43. sub ExplMulti : ATTR(ANY) {
  44.     my ($package, $symbol, $referent, $attr, $data) = @_;
  45.     $data = '<undef>' unless defined $data;
  46.     print STDERR ref($referent), ' ', *{$symbol}{NAME},
  47.              " ($referent) was ascribed ${attr} with data ($data)\n";
  48. };
  49.  
  50. 1;
  51.