summaryrefslogtreecommitdiff
path: root/lib/fields.pm
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2007-07-06 13:58:58 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2007-07-06 13:58:58 +0000
commit9e998a43724115ca2e8c804ade119acbd54d07dd (patch)
tree20bd70c6f40e78437e7802bfe08e700caa7e84ba /lib/fields.pm
parent457f4f73fc6a8a0a2205d2596dac7b13693d3c40 (diff)
downloadperl-9e998a43724115ca2e8c804ade119acbd54d07dd.tar.gz
Upgrade to base and fields 2.12, mostly by Michael G Schwern
p4raw-id: //depot/perl@31540
Diffstat (limited to 'lib/fields.pm')
-rw-r--r--lib/fields.pm128
1 files changed, 64 insertions, 64 deletions
diff --git a/lib/fields.pm b/lib/fields.pm
index cca778f905..44a68c57f8 100644
--- a/lib/fields.pm
+++ b/lib/fields.pm
@@ -3,7 +3,7 @@ package fields;
require 5.005;
use strict;
no strict 'refs';
-unless( eval q{require warnings::register; warnings::register->import} ) {
+unless( eval q{require warnings::register; warnings::register->import; 1} ) {
*warnings::warnif = sub {
require Carp;
Carp::carp(@_);
@@ -11,7 +11,7 @@ unless( eval q{require warnings::register; warnings::register->import} ) {
}
use vars qw(%attr $VERSION);
-$VERSION = '2.03';
+$VERSION = '2.12';
# constant.pm is slow
sub PUBLIC () { 2**0 }
@@ -42,19 +42,19 @@ sub import {
bless \%{"$package\::FIELDS"}, 'pseudohash';
if ($next > $fattr->[0]
- and ($fields->{$_[0]} || 0) >= $fattr->[0])
+ and ($fields->{$_[0]} || 0) >= $fattr->[0])
{
- # There are already fields not belonging to base classes.
- # Looks like a possible module reload...
- $next = $fattr->[0];
+ # There are already fields not belonging to base classes.
+ # Looks like a possible module reload...
+ $next = $fattr->[0];
}
foreach my $f (@_) {
- my $fno = $fields->{$f};
+ my $fno = $fields->{$f};
- # Allow the module to be reloaded so long as field positions
- # have not changed.
- if ($fno and $fno != $next) {
- require Carp;
+ # Allow the module to be reloaded so long as field positions
+ # have not changed.
+ if ($fno and $fno != $next) {
+ require Carp;
if ($fno < $fattr->[0]) {
if ($] < 5.006001) {
warn("Hides field '$f' in base class") if $^W;
@@ -64,19 +64,19 @@ sub import {
} else {
Carp::croak("Field name '$f' already in use");
}
- }
- $fields->{$f} = $next;
+ }
+ $fields->{$f} = $next;
$fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC;
- $next += 1;
+ $next += 1;
}
if (@$fattr > $next) {
- # Well, we gave them the benefit of the doubt by guessing the
- # module was reloaded, but they appear to be declaring fields
- # in more than one place. We can't be sure (without some extra
- # bookkeeping) that the rest of the fields will be declared or
- # have the same positions, so punt.
- require Carp;
- Carp::croak ("Reloaded module must declare all fields at once");
+ # Well, we gave them the benefit of the doubt by guessing the
+ # module was reloaded, but they appear to be declaring fields
+ # in more than one place. We can't be sure (without some extra
+ # bookkeeping) that the rest of the fields will be declared or
+ # have the same positions, so punt.
+ require Carp;
+ Carp::croak ("Reloaded module must declare all fields at once");
}
}
@@ -88,25 +88,25 @@ sub inherit {
sub _dump # sometimes useful for debugging
{
for my $pkg (sort keys %attr) {
- print "\n$pkg";
- if (@{"$pkg\::ISA"}) {
- print " (", join(", ", @{"$pkg\::ISA"}), ")";
- }
- print "\n";
- my $fields = \%{"$pkg\::FIELDS"};
- for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
- my $no = $fields->{$f};
- print " $no: $f";
- my $fattr = $attr{$pkg}[$no];
- if (defined $fattr) {
- my @a;
- push(@a, "public") if $fattr & PUBLIC;
- push(@a, "private") if $fattr & PRIVATE;
- push(@a, "inherited") if $fattr & INHERITED;
- print "\t(", join(", ", @a), ")";
- }
- print "\n";
- }
+ print "\n$pkg";
+ if (@{"$pkg\::ISA"}) {
+ print " (", join(", ", @{"$pkg\::ISA"}), ")";
+ }
+ print "\n";
+ my $fields = \%{"$pkg\::FIELDS"};
+ for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
+ my $no = $fields->{$f};
+ print " $no: $f";
+ my $fattr = $attr{$pkg}[$no];
+ if (defined $fattr) {
+ my @a;
+ push(@a, "public") if $fattr & PUBLIC;
+ push(@a, "private") if $fattr & PRIVATE;
+ push(@a, "inherited") if $fattr & INHERITED;
+ print "\t(", join(", ", @a), ")";
+ }
+ print "\n";
+ }
}
}
@@ -177,16 +177,16 @@ fields - compile-time class fields
{
package Foo;
use fields qw(foo bar _Foo_private);
- sub new {
- my Foo $self = shift;
- unless (ref $self) {
- $self = fields::new($self);
- $self->{_Foo_private} = "this is Foo's secret";
- }
- $self->{foo} = 10;
- $self->{bar} = 20;
- return $self;
- }
+ sub new {
+ my Foo $self = shift;
+ unless (ref $self) {
+ $self = fields::new($self);
+ $self->{_Foo_private} = "this is Foo's secret";
+ }
+ $self->{foo} = 10;
+ $self->{bar} = 20;
+ return $self;
+ }
}
my $var = Foo->new;
@@ -199,15 +199,15 @@ fields - compile-time class fields
{
package Bar;
use base 'Foo';
- use fields qw(baz _Bar_private); # not shared with Foo
- sub new {
- my $class = shift;
- my $self = fields::new($class);
- $self->SUPER::new(); # init base fields
- $self->{baz} = 10; # init own fields
- $self->{_Bar_private} = "this is Bar's secret";
- return $self;
- }
+ use fields qw(baz _Bar_private); # not shared with Foo
+ sub new {
+ my $class = shift;
+ my $self = fields::new($class);
+ $self->SUPER::new(); # init base fields
+ $self->{baz} = 10; # init own fields
+ $self->{_Bar_private} = "this is Bar's secret";
+ return $self;
+ }
}
=head1 DESCRIPTION
@@ -268,11 +268,11 @@ This makes it possible to write a constructor like this:
use fields qw(cat dog bird);
sub new {
- my $self = shift;
- $self = fields::new($self) unless ref $self;
- $self->{cat} = 'meow'; # scalar element
- @$self{'dog','bird'} = ('bark','tweet'); # slice
- return $self;
+ my $self = shift;
+ $self = fields::new($self) unless ref $self;
+ $self->{cat} = 'meow'; # scalar element
+ @$self{'dog','bird'} = ('bark','tweet'); # slice
+ return $self;
}
=item phash