Определите метод в конструкторе класса в Perl - PullRequest
Новая
       25

Определите метод в конструкторе класса в Perl

1 голос
/ 02 марта 2011

Я читаю фрагменты кода, как показано ниже: 

sub new {
        my $pkg  = shift;
        my $args = shift;

        my @keys = keys %$args;

        my $self = bless \%{$args}, $pkg;
        $self->{'__properties'} = \@keys;

        my $class = ref($self);

        foreach my $meth (@keys) {

                if (! $self->can($meth)) {

                        no strict "refs";

                        *{ $class . "::" . $meth } = sub {
                                my $instance = shift;
                                return $instance->{$meth};
                        };
                }
        }

        return $self;
}

В цикле foreach кажется, что он создает некоторые методы в соответствии с параметрами.Есть две строки, которые я не понимаю. Может ли кто-нибудь мне помочь?Для чего используются * и {} ? 

no strict "refs";
*{ $class . "::" . $meth }

С наилучшими пожеланиями,

Ответы [ 2 ]

1 голос
/ 02 марта 2011

Создает псевдоним таблицы символов.
Правая сторона содержит ссылку на функцию, поэтому Perl будет псевдоним ее подпрограмме $meth в пакете $class.

См. Таблицы символов в perlmod.

0 голосов
/ 02 марта 2011

Как уже объяснил Евгений, эти строки манипулируют таблицей символов.С практической точки зрения, они делают это для того, чтобы создавать методы доступа только для чтения в классе на основе любого произвольного списка атрибутов, передаваемых в конструктор: 

#!/usr/bin/env perl

use strict;
use warnings;
use 5.10.0;

package SomeClass;

sub new {
    my $pkg  = shift;
    my $args = shift;

    my @keys = keys %$args;

    my $self = bless \%{$args}, $pkg;
    $self->{'__properties'} = \@keys;

    my $class = ref($self);

    foreach my $meth (@keys) {

        if (!$self->can($meth)) {

            no strict "refs";

            *{$class . "::" . $meth} = sub {
                my $instance = shift;
                return $instance->{$meth};
            };          
        }       
    }   

    return $self;
}

package main;

my $foo = SomeClass->new({foo => 5});   # Creates SomeClass::foo

say $foo->foo;  # 5

my $bar = SomeClass->new({foo => 3, bar => 7});   # Creates SomeClass::bar

say $bar->foo;  # 3
say $bar->bar;  # 7
say $foo->bar;  # undef - ::bar was added to all instances of SomeClass

say $foo->baz;  # Boom!  No such method.

Лично я думаю, что это сомнительная практика ОО(класс должен обычно иметь известный набор атрибутов, а не добавлять новые каждый раз при создании экземпляра), но это то, что он делает ...

...