如何在perl中创建多个对象并获取相同的访问方法?

时间:2016-09-30 13:32:13

标签: perl object hash package

我试图用多种方法创建包并访问它们但它提供了一些哈希值并且预期? 以下是代码:

package student_data;
use strict;
use warnings;
use diagnostics;
use Carp;

# init cell with cell name
sub new_student{
    my ($class,$args) = @_;
     my $self = { student_name => $args->{student_name} || 'default_value',  
          reg_number => $args->{reg_number} || 'default_value',
          dob => $args->{dob} || 'default_value',
          subjects=> {}
                 };

    bless $self, $class;
    return $self;
}


sub new_subject{
    my ($class,$args) = @_;
        my $self = { subject_name => $args->{subject_name} || 'default_value',
             credit => $args->{credit} || 'default_value',  
             grade => $args->{grade} || 'default_value',
                };
    #bless $self, $class;
    return $self
}

sub add_subject{
    my ($self,$args) = @_;
    my $sub1 = $self->new_subject($args);
    ++$self->{subject}{$sub1};
    return $self;
}

sub get_subject{
    my ($self, $args) = @_;
    #$self->{subject}{$sub1};
    return $self;
} 

1;

#use student_data;

my @all_students = ();

my $stud1= student_data->new_student({student_name =>"john",reg_number => "12"});

my $sub1 = student_data->new_subject({subject_name => "A" , credit => "3"}) ;
++$stud1->{subjects}{$sub1};

my $sub2 = student_data->new_subject({subject_name => "B" , grade => "50"}) ;
$stud1->add_subject($sub2);

push(@all_students, $stud1);

my $stud2= student_data->new_student({student_name =>"johnny",dob => "110388"});

my $sub3 = student_data->new_subject({subject_name => "B" , credit => "4"}) ;
++$stud1->{subjects}{$sub3};

my $sub4 = student_data->new_subject({subject_name => "A" , grade => "50"}) ;
$stud1->add_subject($sub4);

push(@all_students, $stud2) ;

my $et_stud = pop(@all_students);

print "\n student_name : $et_stud->{student_name} \n dob : $et_stud->{dob} \n subjects : $et_stud->{subjects}";
  

student_name:johnny
  多布:110388
  科目:HASH(0x10301b8)

但我希望:

  

student_name:约翰尼   reg_number:default_value dob:110388
  subject_name:A
  信用:3
  等级:default_value
  subject_name:B   credit:default_value等级:50

2 个答案:

答案 0 :(得分:1)

我担心你在理解Perl面向对象方面还有很长的路要走,而且除了编写工作版本之外,很难知道如何帮助你

我已更改Student对象的结构,以使其subjects字段为Subject个对象的数组

我可以看到使用哈希的价值,以避免每个学生重复主题,但如果你的原文中没有任何内容,则会涉及错误处理。但是你添加了use Carp所以我包含了代码来使用它来警告构造函数中的错误参数

Student.pm

package Student;

use strict;
use warnings 'all';

use Carp;

sub new {
    my $class = shift;
    my %args = @_;

    my $self = {
        name       => delete $args{student_name} // 'default_value',
        reg_number => delete $args{reg_number} // 'default_value',
        dob        => delete $args{dob} // 'default_value',
        subjects    => [],
    };

    carp 'Unexpected arguments ', join ', ', keys %args if keys %args;

    return bless $self, $class;
}

sub name {
    my $self = shift;

    return $self->{name};
}

sub dob {
    my $self = shift;

    return $self->{dob};
}

sub reg_number {
    my $self = shift;

    return $self->{reg_number};
}

sub add_subject{
    my $self = shift;
    my ($subject) = @_;

    my $subjects = $self->{subjects};

    push @$subjects, $subject;

    return $self;    # So that add_subject may be chained
}

sub subjects { 
    my $self = shift;

    @{ $self->{subjects} };
} 

1;

Subject.pm

package Subject;

use strict;
use warnings 'all';

use Carp;

sub new {
    my $class = shift;
    my %args = @_;

    my $self = {
        name   => delete $args{subject_name} // 'default_value',
        credit => delete $args{credit} // 'default_value',
        grade  => delete $args{grade} // 'default_value',
    };

    carp 'Unexpected arguments ', join ', ', keys %args if keys %args;

    return bless $self, $class;
}

sub name {
    my $self = shift;

    return $self->{name};
}

sub credit {
    my $self = shift;

    return $self->{credit};
}

sub grade {
    my $self = shift;

    return $self->{grade};
}

1;

main.pl

use strict;
use warnings 'all';

use Student;
use Subject;

my @all_students;

my $student;

$student = Student->new( student_name => 'john', reg_number => 12 );
$student->add_subject( Subject->new( subject_name => 'A', credit => 3 ) );
$student->add_subject( Subject->new( subject_name => 'B', grade => 50 ) );

push @all_students, $student;


$student = Student->new( student_name => 'johnny', dob => '110388' );
$student->add_subject( Subject->new( subject_name => 'B', credit => 4  ) );
$student->add_subject( Subject->new( subject_name => 'A', grade => 50 ) );

push @all_students, $student;


my $et_stud = pop @all_students;

printf "student_name: %s\n", $et_stud->name;
printf "reg_number: %s\n", $et_stud->reg_number;
printf "dob: %s\n", $et_stud->dob;

for my $subject ( $et_stud->subjects ) {
    print "\n";
    printf "  subject_name: %s\n", $subject->name;
    printf "  credit: %s\n", $subject->credit;
    printf "  grade: %s\n", $subject->grade;
}

输出

student_name: johnny
reg_number: default_value
dob: 110388

  subject_name: B
  credit: 4
  grade: default_value

  subject_name: A
  credit: default_value
  grade: 50

答案 1 :(得分:0)

add_subject函数中,您使用new_subject()返回的未完成对象作为键:

my $sub1 = $self->new_subject($args);
++$self->{subject}{$sub1};

但是Perl中的键必须是标量,因此对象将转换为类似'HASH(0x1a1c148)'的字符串。

如果要存储对象,请将它们存储为值。例如,您可以在对象中存储数组引用:

sub new_student {
  my ($class, $args) = @_;
  my @subjects;
  return bless {
    # other properties are skipped
    subjects => \@subjects
  }, $class;
}

sub add_subject{
  my ($self,$args) = @_;
  my $sub1 = $self->new_subject($args);
  push @{ $self->{subjects} }, $sub1;
  return $self;
}

然后你可以自由地遍历主题:

print "subjects:\n";
foreach my $subj (@{ $et_stud->{subjects} }) {
  print "subject_name: ", $subj->{subject_name} // '(none)', "\n",
    "credit: ", $subj->{credit} // '(none)', "\n",
    "grade: ", $subj->{grade} // '(none)', "\n";
}

第二件事。您正在检查@all_students数组中的最后一项 - $stud2没有添加任何主题。

您可能需要查看学生科目的编号:

if (scalar @{ $et_stud->{subjects} }) {
  # run the loop...
} else {
  print "Student $et_stud->{student_name} has no subjects.\n";
}

(标量上下文中的数组返回项目数。)