Harshad
Harshad

Reputation: 33

How to create multiple objects in perl and access methods for same?

I was trying to create package with multiple methods and access them but it gives some hash values and expected? following is code:

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
dob : 110388
subjects : HASH(0x10301b8)

but I expect :

student_name : johnny reg_number : default_value dob : 110388
subject_name : A
credit : 3
grade : default_value
subject_name : B credit : default_value grade : 50

Upvotes: 2

Views: 539

Answers (2)

Borodin
Borodin

Reputation: 126742

I'm afraid you're really a very long way off from understanding Perl object-orientation, and it's really hard to know how to help you other than just writing a working version

I've changed the structure of a Student object so that its subjects field is an array of Subject objects

I could see the worth of using a hash to avoid duplicating subjects per student, but that would involve error handling when there is none in your original. However you have added use Carp so I included code to use it to warn of incorrect arguments in the constructors

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;
}

output

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

Upvotes: 2

Ruslan Osmanov
Ruslan Osmanov

Reputation: 21502

In the add_subject function you're using the unblessed object returned by new_subject() as a key:

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

But the keys must be scalar in Perl, so the object is converted to a string like 'HASH(0x1a1c148)'.

If you want to store the objects, store them as values. For example, you might store an array reference in the object:

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;
}

Then you might iterate over the subjects freely:

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";
}

Second thing. You're examining the last item in the @all_students array - $stud2 which has no subjects added.

You might want to check the number of the student subjects:

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

(an array in scalar context returns the number of items.)

Upvotes: 0

Related Questions