#OOP programme to insert, manipulate + display fields from an array of hash references containing key/value pairs. 
 
#////////////////////////////////////////////////// 
 
#!/usr/bin/perl 
use strict; 
use warnings; 
use Cwd; 
use CGI ':standard'; 
use CGI::Carp qw(fatalsToBrowser warningsToBrowser); 
print "Content-type: text/html\n\n"; 
warningsToBrowser(1); 
 
#////////////////////////////////////////////////// 
 
{ 
	package profilePeople; 
	 
	use strict; 
	use warnings; 
	use Storable; 
	use Data::Dumper; 
	 
	sub AUTOLOAD { #input=N/A, output=N/A [default method if a method does not exist] 
		our $AUTOLOAD; 
		$AUTOLOAD =~ s/.*:://s; 
		die "Method $AUTOLOAD is not a method of the profilePeople package.\n"; 
	} 
	 
	sub new { #input=hash ref(s), output=object [overwrites existing object] 
		my $class = shift; 
		my @people = @_; 
		my $self = []; 
		my $return = undef; 
		 
		bless $self, $class; 
		$self->newPeople(@people); 
		$return = $self; 
		 
		return $return; 
	} 
	 
	sub newFromDisk { #input=scalar then hash ref(s), output=object [overwrites existing object] 
		my $class = shift; 
		my $path = shift; 
		my @people = @_; 
		my $self = retrieve $path; 
		my $return = undef; 
 
		die "Data reference retreived from disk is not an object of the profilePeople package.\n" unless (eval { $self->isa('profilePeople') }); 
		bless $self, $class; 
		$self->newPeople(@people); 
		$return = $self; 
		 
		return $return; 
	} 
	 
	sub outputToDisk { #input=scalar, output=true 
		my $self = shift; 
		my $path = shift; 
		 
		store $self, $path; 
		 
		return 1; 
	} 
	 
	sub newPeople { #input=hash ref(s), output=array ref 
		my $self = shift; 
		my @people = @_; 
		my $return = []; 
		 
		foreach my $person (@people) { 
			bless $person; #create an instance in the current package 
			push @$return, $person; 
			push @$self, $person; 
		} 
		 
		return $return; 
	} 
	 
	sub updatePeople { #input=hash ref then subroutine ref, output=array ref 
		my $self = shift; 
		my $update = shift || {}; 
		my $condition = shift || sub{1}; 
		my $return = []; 
		 
		foreach my $index (0 .. $#$self) { 
			if (&$condition($self->[$index])) { 
				while (my ($key, $value) = (each %$update)) { 
					#if ($value eq '') { delete $self->[$index]{$key}; next; } #removes key/value pairs where the value is empty 
					$self->[$index]{$key} = $value;		 
				} 
				push @$return, $self->[$index]; 
			} 
		} 
		 
		return $return; 
	} 
	 
	sub deletePeople { #input=subroutine ref, output=array ref 
		my $self = shift; 
		my $condition = shift || sub{1}; 
		my $return = []; 
		 
		foreach my $index (0 .. $#$self) { 
			if (&$condition($self->[$index])) { 
				push @$return, $self->[$index]; 
				delete $self->[$index]; 
			} 
		} 
		 
		return $return; 
	} 
	 
	sub findPeople { #input=subroutine ref, output=array ref 
		my $self = shift; 
		my $condition = shift || sub{1}; 
		my $return = []; 
		 
		@$return = grep { &$condition($_) } @$self; 
		 
		return $return; 
	} 
	 
	sub getValues { #input=scalar(s), output=array ref 
		my $self = shift; 
		my @keys = @_; 
		my $return = []; 
		 
		foreach my $key (@keys) { 
			push @$return, $self->{$key}; 
		} 
		 
		return $return; 
	} 
	 
	sub dumpObject { #input=N/A, output=scalar 
		my $self = shift; 
		my $return = undef; 
		 
		$return = Dumper($self); 
		 
		return $return; 
	} 
} 
 
#////////////////////////////////////////////////// 
 
my $object = profilePeople->new( 
	{'name' => 'peter'}, 
	{'name' => 'william'}, 
	{'name' => 'chris', 'age' => "20", 'sex' => 'male'}, 
	{'name' => 'john', 'age' => "44", 'sex' => 'male'}, 
	{'name' => 'laura', 'age' => "22", 'sex' => 'female'} 
); 
##### 
my $up = $object->updatePeople( 
	{'name' => 'newname', 'age' => "", 'location' => 'UK'}, 
	sub{$_[0]->{'name'} eq 'chris'} 
); 
##### 
my $dp = $object->deletePeople( 
	sub{$_[0]->{'name'} =~ m/laUrA|john/i} 
); 
##### 
my $np = $object->newPeople( 
	{'name' => 'emily', 'age' => "28", 'location' => 'UK'}, 
	{'name' => 'chris', 'age' => "41", 'sex' => 'male'}, 
); 
##### 
my $fp = $object->findPeople( 
	sub{($_[0]->{'age'} > 21) || ($_[0]->{'name'} =~ m/W/i)} 
); 
#print $_->{'name'}, '<br />' foreach (@$fp); #its bad to look inside the black box 
foreach my $person (@$fp) { 
	print join ', ', grep { defined } @{$person->getValues('name', 'age')}, "<br >\n"; 
} 
##### 
$object->outputToDisk(getcwd().'/store.txt'); 
my $newobject = profilePeople->newFromDisk( 
	getcwd().'/store.txt', 
	{'name' => 'lucy', 'age' => "27", 'sex' => 'female', 'location' => 'USA'} 
); 
print $newobject->dumpObject; 
##### 
#$newobject->nonexistantmethod; 
 
#//////////////////////////////////////////////////

foreach my $person (@$fp) {  
	print join ', ', grep { defined } @{$person->getValues('name', 'age')}, "<br >\n";  
}