#!/usr/bin/perl use strict; use warnings; package User; # our @references; sub new { my ($class, %arg) = @_; my $self = { _name => $arg{name} || "unknown" ,_team => $arg{team} || "unknown" }; bless $self, $class; #push @references, $self; my ($team) = Team->find($arg{team}) ; $arg{team} and ( $team ||= Team->new($arg{team}) ); $team and $team->AddUser($self); return $self; } sub name{ # Accessor $_[0]->{_name}; } sub List_Opponents { my $self = shift @_; my $myTeam = Team->find( $self->{_team} ); foreach my $T (Team->GetTeamList()) { next if $self->{_team} eq $T->{name}; #find opposing team #do something to $T print " " . $self->name . "\ton $self->{_team} vs. " . "\tmembers of $T->{name} \n"; } } sub getUserByName{ my ($self, $lookfor) = @_; my @Users; foreach my $t (Team->GetTeamList()) { # next if $self->{_team} eq $t->{name}; push @Users, grep {$_->name eq $lookfor} $t->GetUserList; } return @Users } ######################################## package Team; my @TeamList; sub new{ my ($class, $name) = @_; my $self = {name=>$name}; bless $self, $class; push @TeamList, $self; return $self; } sub AddUser{ #By Object my $self = shift; while (local $_=shift){ # $_ contains the NAME of the user to add my $userTeam= findUserObj ($self, $_); # Look for This userobj if ($userTeam){ $userTeam == $self and next; # is already there in this list. dont add again warn "*** User " . $_->name . " is already in team $userTeam->{name}. Now also added to $self->{name}\n"; } push @{$self->{userlist}},$_; } } sub CreateAndAddUser{ my ($self, @UserNames) = @_; AddUser($self, map {User->new(name => $_, team=> $self->{name})} @UserNames ); } sub GetUserList{ my $self = shift; return () unless exists $self->{userlist} ; return ( @{$self->{userlist}} ); } sub find{ #Return Team object (or undef) given team NAME. my $self = shift; my $lookfor = shift || $self; # In case CLASS method is called. for my $t(@TeamList){ return $t if $t->{name} eq $lookfor; } return undef; } sub findUserObj{ my ($self, $UserObj) = @_; for my $t (@TeamList){ return $t if grep {$_ == $UserObj} GetUserList($t) ; } return undef; } sub GetTeamList{ return @TeamList; } ############################################## package main; my $t1 = Team->new ("MyTeam"); my $t2 = Team->new ("OtherTeam"); my $SingleUser = User->new(name => "OneSingleUser", team=> "teamBeta"); my @testUsers = ( (map { User->new(name => "user$_", team=> "teamalpha")} 0..4), (map { User->new(name => "user$_", team=> "teamBeta") } 5..9) ); #Cread Anon Team object (which we can find later) Team->new("Planets")->CreateAndAddUser( qw /mercury venus earth mars jupiter /); $t1->AddUser (@testUsers[0,1,2] ); $t2->AddUser (@testUsers[3,5,6] ); $t1->CreateAndAddUser( qw /foo bar baz quux /); $t2->CreateAndAddUser( qw /Ahmed sohrab rustom quasim /); Team->find("Planets")->CreateAndAddUser( qw /saturn Asteroids pluto/); $testUsers[0]->List_Opponents(); $testUsers[5]->List_Opponents(); $SingleUser->List_Opponents(); for my $t (Team->GetTeamList()){ print "---Team: $t->{name} -----\n"; print " " . $_->name . "\n" for $t->GetUserList; }