PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|Perl|site_perl|Class|Accessor.pm =

page 2 of 7



correspond to the names of your accessors, so...

    package Foo;
    use base qw(Class::Accessor);
    Foo->mk_accessors('foo');

    my $obj = Class->new({ foo => 42 });
    print $obj->foo;    # 42

however %fields can contain anything, new() will shove them all into
your object.  Don't like it?  Override it.

=cut

sub new {
    my($proto, $fields) = @_;
    my($class) = ref $proto || $proto;

    $fields = {} unless defined $fields;

    # make a copy of $fields.
    bless {%$fields}, $class;
}

=head2 mk_accessors

    Class->mk_accessors(@fields);

This creates accessor/mutator methods for each named field given in
@fields.  Foreach field in @fields it will generate two accessors.
One called "field()" and the other called "_field_accessor()".  For
example:

    # Generates foo(), _foo_accessor(), bar() and _bar_accessor().
    Class->mk_accessors(qw(foo bar));

See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
for details.

=cut

sub mk_accessors {
    my($self, @fields) = @_;

    $self->_mk_accessors('rw', @fields);
}


{
    no strict 'refs';

    sub _mk_accessors {
        my($self, $access, @fields) = @_;
        my $class = ref $self || $self;
        my $ra = $access eq 'rw' || $access eq 'ro';
        my $wa = $access eq 'rw' || $access eq 'wo';

        foreach my $field (@fields) {
            my $accessor_name = $self->accessor_name_for($field);
            my $mutator_name = $self->mutator_name_for($field);
            if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) {
                $self->_carp("Having a data accessor named DESTROY  in '$class' is unwise.");
            }
            if ($accessor_name eq $mutator_name) {
                my $accessor;
                if ($ra && $wa) {
                    $accessor = $self->make_accessor($field);
                } elsif ($ra) {
                    $accessor = $self->make_ro_accessor($field);
                } else {
                    $accessor = $self->make_wo_accessor($field);
                }
                unless (defined &{"${class}::$accessor_name"}) {
                    *{"${class}::$accessor_name"} = $accessor;
                }
                if ($accessor_name eq $field) {
                    # the old behaviour
                    my $alias = "_${field}_accessor";
                    *{"${class}::$alias"} = $accessor unless defined &{"${class}::$alias"};
                }
            } else {
                if ($ra and not defined &{"${class}::$accessor_name"}) {
                    *{"${class}::$accessor_name"} = $self->make_ro_accessor($field);
                }
                if ($wa and not defined &{"${class}::$mutator_name"}) {
                    *{"${class}::$mutator_name"} = $self->make_wo_accessor($field);
                }
            }
        }
    }

    sub follow_best_practice {
        my($self) = @_;
        my $class = ref $self || $self;
        *{"${class}::accessor_name_for"}  = \&best_practice_accessor_name_for;
        *{"${class}::mutator_name_for"}  = \&best_practice_mutator_name_for;
    }

}

=2=

1| < PREV = PAGE 2 = NEXT > |3|4|5|6|7

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.00562119 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU)