package shapes;

#constructor
sub new {
    my ($invocant, %hash) = @_;    
    my $class   = ref($invocant) || $invocant;

    my $self = {
        shape  => $hash{'shape'},
        };


    return bless $self, $class;
}

sub print_shape {
    
   my $self = shift;
   print $self->{'shape'}->{'line1'} . "\n";
   print $self->{'shape'}->{'line2'} . "\n";
   print $self->{'shape'}->{'line3'} . "\n";
}

1;
[download]

use shapes;

my $box;
$box->{line1} =  ' ---';
$box->{line2} =  '|    |';
$box->{line3} =  ' ---';

my $box = shapes->new(shape => $box);
$box->print_shape;
[download]

Well, there are several things that come to mind here. First off, you don't store the parameter hash you're giving the object in the constructor (actually you could bless the hash itself, but this is a bit beside the point). I would change the constructor to the following:

sub new {
    my ( $invocant, %shape ) = @_; # Stash all params into shape
    my $class   = ref($invocant) || $invocant; 

    my $self = {
        shape  => \%shape, # Store a reference to the shape
        };
    return bless $self, $class;
}
[download]

Secondly, you're only making an object, not actually asking it to do anything. To get it to print, you have to callt the print_shape method:

my $box = shapes->new(shape => %box);
$box->print_shape(); # Do som real work
[download]

Thirdly, your print_shape is a bit odd, in that it only will print the first line of the shape, not the entire shape. To print the entire box, you would have to iterate through the hash you've stored in shape, but then you'll lose your ordering.

Lastly, to develop on the point of the print_shape, you should perhaps store some ordering information with the hash. As an alternative you could use an array instead of a hash, as this would retain the order of your lines. Eg:

sub new {
    my ( $invocant, @lines ) = @_; # Take the lines in orden

# The line below is a bit cargo cultish, and I won't go into the reaso
+n here
# Super search for clone / constructor for more info / enlightenment
#    my $class   = ref($invocant) || $invocant;
    my $self = {
        shape  => \@lines,
        };
    return bless $self, $invocant;
}

sub print_shape {
   my $self = shift;      
   my @lines = @{ $self->{ 'shape' } };

   foreach my $line( @lines ) {
      print $lines, "\n";
   }
}
[download]

This code is untested, of course. Good luck!

Update: Take a look at this node for an example discussion of the hornet's nest that is the copy-constructor. I realize that I was a bit impatient in my pointing to super search ...

Thanks for the reply,
It was only after submitting the question that i realised that I had left out the

 
$box->print_shape();
[download]

and also printing of line two and three in the method print_shape. So all that was in the original code.
My original idea was to have each shape 3 lines long, and then just hardcode the printing of the hash. I have this sample code running with arrays, but was using a hash for extra learning value.
Ant

Taking a quick glance I agree with most of what has already been posted here. Your two main problems are a) not using the data you pass to the constructor and b) only attempting to print the first line of data.

I tend to agree that the data in this case should be passed as an array reference and not a hashref. Passing as a hashref is limiting you to either only having boxes with the same number of lines each time:

# Only ever produces 3 lines
sub print_shape {
  my $self=shift;
  print $self->{shape}->{line1}."\n";
  print $self->{shape}->{line2}."\n";
  print $self->{shape}->{line3}."\n";
}
[download]

or having to get into some weird eval stuff:

# Allows for arbitary number of lines
# (as long as they are sequentially numbered from 1)
sub print_shape {
  my $self=shift;
  my $em='';
  for (my $i=0; $i<scalar(keys %{$self->{shape}}); $i++) {
    $em = 'print $self->{shape}->{line' . ($i+1) . '}."\n"';
    eval($em);
  }
}
[download]

Would be much neater to define your shape thus:

my $box = [
  '----',
  '|  |',
  '----'
];
[download]

... which would mean you could then have your print_shape() as a nice little:

sub print_shape {
  my $self=shift;
  foreach (@{$self->{shape}}) {
    print "$_\n";
  } 
}
[download]

Remember to be careful with hashes as you can't ever gurantee you'll get the keys/values back out in the order in which you put them in (unless you start sorting.

package NP;

require 5.00503;
require Exporter;

use strict;
use warnings;
use Carp;
use Data::Dumper;
use vars qw/ @ISA @EXPORT /;

@ISA = qw/ Exporter /;
@EXPORT = qw/ ParseNamedParameters /;


sub ParseNamedParameters
{
    my $allowed_parameters = shift;
    my @param = split /\|/, $allowed_parameters;
    my %param = ();

    return undef unless scalar @_; # must have something to decode fir
+st

    if (ref $_[0] eq 'HASH') {
        # Parameters passed in as HASHREF
        for my $p (keys %{$_[1]}) {
            if ($p !~ /^(?:$allowed_parameters)$/i) {
                print "Unknown parameter '$p', must be [$allowed_param
+eters]\n";
            } else {
                $param{'_' . lc $p} = $_[1]->{$p};
            }
        }
    } elsif ($_[0] =~ /^-(?=$allowed_parameters)/i) {
        # Parameters passed in as named parameters
        my (%p) = @_;
        for my $p (keys %p) {
            if ($p !~ /^-(?:$allowed_parameters)$/i) {
                print "Unknown parameter '$p', must be [$allowed_param
+eters]\n"
            } else {
                $param{'_' . lc substr($p,1)} = $p{$p};
            }
        }
    } else {
        for my $p (@param) {
            my $val = shift;
            $param{'_' . lc $p} = $val;
        }
    }

    return \%param;
}

1;


package shapes;
use NP;

sub new {
    my $class = shift || "shapes";
    my $self = {};
    bless $self, $class;

    my $allowed_parameters = "shape";

    # only decode parameters for the base object
    # derived objects have to decode their own parameters
    if ($class eq "shapes") {
        my $param = ParseNamedParameters($allowed_parameters, @_);
        @{$self}{keys %$param} = values %$param;
    }

    return $self;
}

sub print_shape {

   my $self = shift;
   print $self->{_shape}{line1} . "\n";
   print $self->{_shape}{line2} . "\n";
   print $self->{_shape}{line3} . "\n";
}

1;


#!/usr/bin/perl -w
use strict;
use lib "./";
use shapes;

my %box;
$box{line1} =  ' ---';
$box{line2} =  '|    |';
$box{line3} =  ' ---';

my $box = shapes->new(-shape => \%box);
$box->print_shape();
[download]

if (ref $_[0] eq 'HASH') {
[download]

This seems to a bit of a religious subject, but personally I consider such checks as this to be totally wrong. You probably really want one of the below:

#1
if (eval{ $_[0]->{''}, 1 }) {

#2
use Scalar::Util qw(reftype);
if (reftype $_[0] eq 'HASH') {

#3
if (UNIVERSAL::isa($_[0],'HASH')) {
[download]

I only consider the first to be really robust, the second is fairly robust but could do the wrong thing if the object was actually a different type but had hash overloading semantics. The third is passable, but is easily fooled into causing errors, and the version you used suffers from all of the problems mentioned for my examples as well as the flaw that it plain and simply can't be used with blessed hashes which IMO is just bad design.

Anyway, you may not agree with my POV here, but if you haven't thought your position through on this type of thing its probably worth doing so.


---
demerphq


First they ignore you, then they laugh at you, then they fight you, then you win.
-- Gandhi

Flux8

If I want to use named arguments, most of the time I just assign @_ to a hash (which works for the majority of the cases, where all you can pass are key value pairs). If I want to do any "parsing", I use Getopt::Long. Why reinvent the wheel?

Well, it's doing more than key value pairs, it also allow traditional parameter passing methods.



mysub( $v1, $v2, $v3, $v4 );

mysyb( -v1 => $v1, -v3 => $v3 );
[download]


I like to have the freedom of using either calling convension. Just a personal preference.

sub print_shape {
    
   my $self = shift;      
   print $self->{shape}{line1} , "\n",
         $self->{shape}{line2} , "\n",
         $self->{shape}{line3} , "\n";   

}
[download]