Perl: Subroutines first argument is not the class - perl

I'm relatively new to Perl so bear with me.
My sub getGenes calls getFeaturesByGeneName in the class SequenceModule. The first loop runs fine however in the second loop it tries to invoke get_SeqFeatures (a BioPerl sub) on the string $name meaning that it skips my $self = shift.
What am I missing?
sub getGenes
{
my #names = shift;
my $genome = shift;
my #cds;
foreach my $name (#names)
{
my $feat = SequenceModule -> getFeatureByGeneName($genome, $name);
push (#cds, $feat);
}
return #cds;
}
...
sub getFeatureByGeneName
{
my $self = shift;
my $seq = shift;
my $name = shift;
my #cds = $seq -> get_SeqFeatures("CDS");
...
}

Speculation: you called getGenes with several names:
getGenes(('name1', 'name2'), $genome);
List don't nest in Perl, so the arguments are flattened:
getGenes('name1', 'name2', $genome);
shift can't return more than one element. Therefore,
my #names = shift;
is equivalent to
my #names;
$names[0] = shift;
The second name is still in #_, so it goes to $genome:
my $genome = shift;
If you need to pass a list to a sub, make it the last argument, or send a reference:
sub getGenes {
my $genome = shift;
my #names = #_;
}
getGenes($genome, 'name1', 'name2');
# OR
sub getGenes {
my $names = shift;
my $genome = shift;
for my $name (#$names) { # dereference
...
}
}
getGenes(['name1', 'name2'], $genome);

Related

Tail call Recursion "Optimising"

I have a weird problem I can't figure out. I created a simple sequence in Perl with anonymous functions.
sub{($data, sub{($data, sub{($data, sub{($data, empty)})})})};
And it works but I tired to implement tail optimizing and got some weird behaviour. Example. The iter function below works.
sub iter {
my ($func, $seq) = #_;
my ($data, $next) = $seq->();
if (defined $data) {
$func->($data);
#_ = ($func, $next);#This #_ update works fine
goto &iter;
}
}
while this implementation of iter fails.
sub iter {
my ($func, $seq) = #_;
my ($data, $next) = $seq->();
if (defined $data) {
$func->($data);
$_[1] = $next; #This #_ update fails
goto &iter;
}
}
Both updates of #_ yield the same values for #_ but the code behaves differently when it continues.. To see what I'm talking about try running the complete code below.
#! /usr/bin/env perl
package Seq;
use 5.006;
use strict;
use warnings;
sub empty {
sub{undef};
}
sub add {
my ($data, $seq) = #_;
sub{($data, $seq)};
}
sub iter {
my ($func, $seq) = #_;
my ($data, $next) = $seq->();
if (defined $data) {
$func->($data);
#_ = ($func, $next);#This works fine
#$_[1] = $next; #This fails
goto &iter;
}
}
sub smap {
my ($func, $seq) = #_;
my ($data, $next) = $seq->();
if (defined $data) {
sub{($func->($data), Seq::smap($func, $next))};
}else {
empty();
}
}
sub fold {
my ($func, $acc, $seq) = #_;
my ($data, $next) = $seq->();
if (defined $data) {
#_ = ($func, $func->($acc, $data), $next);
goto &Seq::fold;
}else {
$acc;
}
}
1;
package main;
use warnings;
use strict;
use utf8;
use List::Util qw(reduce);
my $seq =
reduce
{Seq::add($b, $a)}
Seq::empty,
(4143, 1234, 4321, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
Seq::iter(sub{my ($data) = #_; STDOUT->print("$data\n")}, $seq);
my $seq2 = Seq::smap(sub{my ($data) = #_; $data * 2}, $seq);
STDOUT->print("\n\n");
Seq::iter(sub{my ($data) = #_; STDOUT->print("$data\n")}, $seq2);
STDOUT->print("\n\n");
my $ans = Seq::fold(sub{my ($acc, $data) = #_; $acc + $data}, 0, $seq);
my $ans2 = Seq::fold(sub{my ($acc, $data) = #_; $acc + $data}, 0, $seq2);
STDOUT->print("$ans\n");
STDOUT->print("$ans2\n");
exit (0);
The code should work for both examples of iter but it doesn't.. Any pointers why?
Writing to $_[1] writes to the second scalar passed to the sub.
$ perl -E'$x = "abc"; say $x; sub { $_[0] = "def"; say $_[0]; }->($x); say $x;'
abc
def
def
So you are clobbering the caller's variables. Assigning to #_ replaces the scalars it contains rather than writing to them.
$ perl -E'$x = "abc"; say $x; sub { #_ = "def"; say $_[0]; }->($x); say $x;'
abc
def
abc
You can replace a specific element using splice.
$ perl -E'$x = "abc"; say $x; sub { splice(#_, 0, 1, "def"); say $_[0]; }->($x); say $x;'
abc
def
abc
It's far more convenient for iterators to return an empty list when they are exhausted. For starters, it allows them to return undef.
Furthermore, I'd remove the expensive recursive calls with quicker loops. These loops can be made particularly simple because of the change mentioned above.
The module becomes:
package Seq;
use strict;
use warnings;
sub empty { sub { } }
sub add {
my ($data, $seq) = #_;
return sub { $data, $seq };
}
sub iter {
my ($func, $seq) = #_;
while ( (my $data, $seq) = $seq->() ) {
$func->($data);
}
}
sub smap {
my ($func, $seq) = #_;
if ( (my $data, $seq) = $seq->() ) {
return sub { $func->($data), smap($func, $seq) };
} else {
return sub { };
}
}
sub fold {
my ($func, $acc, $seq) = #_;
while ( (my $data, $seq) = $seq->() ) {
$acc = $func->($acc, $data);
}
return $acc;
}
1;
Also, for speed reasons, replace
sub { my ($data) = #_; $data * 2 }
sub { my ($acc, $data) = #_; $acc + $data }
with
sub { $_[0] * 2 }
sub { $_[0] + $_[1] }

How to return two values in getter method in Perl?

use strict;
use warnings;
package LineSegment;
sub new
{
my $class = shift;
my ($ax, $ay, $bx, $by) = #_;
my $self = {"ax"=>$ax,
"ay"=>$ay,
"bx"=>$bx,
"by"=>$by,
};
bless ($self, $class);
return $self;
}
sub getA{
#Issue on get A
my $self = shift;
return ($self->{ax}, $self->{ay});
}
sub getB{
#Issue on get B
my $self = #_;
return ($self->{bx}, $self->{by});
}
sub setA{
#Can print correct value. Is the return statement where it goes wrong?
my($self, $ax, $ay) = #_;
$self->{ax} = $ax if defined($ax);
$self->{ay} = $ay if defined($ay);
print "Setting ax: $self->{ax}\n";
print "Setting ay: $self->{ay}\n";
return ($self->{ax}, $self->{ay});
}
sub setB{
#Can print correct value. Is the return statement where it goes wrong?
my($self, $bx, $by) = #_;
$self->{bx} = $bx if defined($bx);
$self->{by} = $by if defined($by);
return $self->{bx}, $self->{by};
}
1;
I am trying to create a class called LineSegment. ax and ay are a
point and so are bx and by. I cannot get getA or getB to return what I
want. They only return the second value, which would be ay for getA
and by for getB. I want it to return both values (ax, ay) or (bx,by).
How do I get it to do this? In my setA and setB methods, the values
will print. However, could I be returning them wrong in setA and setB?
Or does my problem lie in my getter methods?
Here is my main:
print "Starting Line Segment\n";
use LineSegment;
$line = new LineSegment(10,20,30,40);
$line->setA(15,10);
$a = $line->getA();
print "Point A is: $a\n";
Here is my Point class:
use strict;
use warnings;
#class name
package Point;
#constructor
sub new
{
my $class = shift;
my($x, $y) = #_;
my $self = {"x"=>$x,
"y"=>$y,
};
bless ($self, $class);
return $self;
}
sub getX{
my($self) = #_;
return $self->{x};
}
sub setX{
my ($self, $x) = #_;
$self->{x} = $x if defined($x);
return $self->{x};
}
sub setY{
my ($self, $y) = #_;
$self->{y} = $y if defined($y);
return $self->{y};
}
sub random{
my $self = shift;
my $range = 50;
$self->{x} = int(rand($range));
$self->{y} = int(rand($range));
return ($self->{x}, $self->{y});
}
1;
Updated main:
use strict;
use warnings;
use Point;
use LineSegment;
my $line = LineSegment->new(Point->new()->random, Point->new()->random);
my $pointA = $line->getA;
my $pointB = $line->getB;
printf "Point = (%d,%d)\n", $pointA->getX, $pointA->getY;
As Tanktalus has pointed out, you are returning a list of two values and expecting to be able to treat it as a single Point object. A list in scalar context evaluates to the last element of the list, so you are getting just the Y coordinate
I've written some functioning code below. One thing that may confuse you is the hash slice syntax #{$self}{qw/ _x _y /} = #_ which is the same as
$self->{_x} = $_[0];
$self->{_y} = $_[1];
You should remember to use strict and use warnings at the top of every Perl source file. You should also avoid using $a and $b as they are used internally by Perl. Longer, more descriptive identifiers are better anyway
If I alter your Point.pm so that its constructor takes parameters (I have also fixed your random method) like this
Point.pm
use strict;
use warnings 'all';
package Point;
sub new {
my $class = shift;
my $self = { };
#{$self}{qw/ _x _y /} = #_ if #_;
bless $self, $class;
}
sub getX{
my $self = shift;
return $self->{_x};
}
sub getY{
my $self = shift;
return $self->{_y};
}
sub setX {
my $self = shift;
$self->{_x} = $_[0] if #_;
return $self->{_x};
}
sub setY {
my $self = shift;
$self->{_y} = $_[0] if #_;
return $self->{_y};
}
use constant RANGE => 50;
sub random {
my $self = shift;
$self->{_x} = int rand RANGE;
$self->{_y} = int rand RANGE;
return $self;
}
1;
and write LineSegment.pm like this
LineSegment.pm
use strict;
use warnings 'all';
package LineSegment;
sub new {
my $class = shift;
my $self = { };
#{$self}{qw/ _pA _pB /} = #_ if #_;
bless $self, $class;
}
sub getA {
my $self = shift;
return $self->{_pA};
}
sub getB {
my $self = shift;
return $self->{_pB};
}
sub setA {
my $self = shift;
$self->{_pA} = $_[0] if #_;
return $self->{_pA};
}
sub setB {
my $self = shift;
$self->{_pB} = $_[0] if #_;
return $self->{_pB};
}
1;
then I can write a program which does what I think you want like this
main.pl
use strict;
use warnings 'all';
use Point;
use LineSegment;
my $line = new LineSegment(
Point->new(10, 20),
Point->new(30, 40),
);
$line->setA( Point->new(15, 10) );
my $point = $line->getA;
printf "Point = (%d,%d)\n",
$point->getX,
$point->getY;
output
Point = (15,10)
my ($ax, $ay) = $line->getA();
getA() is returning a list of variables, you need to receive it into a list of variables. An array would work as well, but this is probably clearer.
But that's not really what you want. What you want to do is to have a line segment be made up of two Point objects (which you may have to create as well), and each Point object store its own x and y coordinates. And then you can return the points as objects, and query their x and y coordinates, e.g.:
my $a_point = $line->getA();
print "Point A is (", $a_point->getX(), ",", $a_point->getY(), ")";
(You can also have the Point class override stringification, but I suspect that's more than you want to think about just yet.)
Apologies for not catching this the first time, but not only are single-letter variable names poor taste in general, $a and $b are particularly bad in perl because they're reserved for the sort function. So I've renamed it here.
With your update, your Point class is missing the getY method. Your main script becomes:
use strict;
use warnings;
use LineSegment;
print "Starting Line Segment\n";
my $line = new LineSegment(10,20,30,40);
$line->setA(15,10);
my $p = $line->getA();
print "Point A is: (", $p->getX(), ",", $p->getY(), ")\n";
and your LineSegment.pm becomes:
package LineSegment;
use strict;
use warnings;
use Point;
sub new
{
my $class = shift;
my #points;
if (#_ == 4)
{
#points = (
Point->new($_[0], $_[1]),
Point->new($_[2], $_[3]),
);
}
else
{
#points = #_;
}
my $self = \#points;
bless ($self, $class);
return $self;
}
sub getA{
#Issue on get A
my $self = shift;
return $self->[0];
}
sub getB{
#Issue on get B
my $self = shift;
return $self->[1];
}
sub setA{
#Can print correct value. Is the return statement where it goes wrong?
my $self = shift;
my $point = $_[0];
if (#_ > 1)
{
$point = Point->new(#_);
}
$self->[0] = $point;
}
sub setB{
my $self = shift;
my $point = $_[0];
if (#_ > 1)
{
$point = Point->new(#_);
}
$self->[1] = $point;
}
1;
This may be a bit overkill, but the right answer is to only pass in/around Point objects in your LineSegment, and let the caller create the Point objects instead of massaging them in here. In my experience, this makes the whole thing clearer.
You have complete answers by Borodin and Tanktalus
showing how to write this class, with other comments. They also emphasize that a segment class should fully utilize a point class.
This is an important point. We encapsulate a certain aspect of our problem in a class. Then we want to use that class for other aspects of the problem, and this is crucial in the object-oriented approach. It usually requires iterations in design and coding, to get those classes right.
This post demonstrates the process by adding a method for the length of a segment, what prompts addition of other methods. I also add a few other pieces to your classes
A couple of utility methods are added in the Point class that are helpful for the length method, and that belong there in general. This is typical -- we desire new functionality and realize that the other classes should provide a part (or all) of it.
Defaults are added to the constructors. Once new is called the objects should be initialized and ready to go, if possible. Your Point::random method is used for this.
A setter and getter are combined in one method, which sets data when called with parameters
Some comments follow the code.
Point.pm
package Point;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = { };
bless $self, $class; # now we can call methods on $self
if (#_) {
#{$self}{qw(_x _y)} = #_; # initialize via parameters
} else {
$self->random(); # initialize using random()
}
return $self;
}
sub x {
my $self = shift;
$self->{_x} = $_[0] if $_[0]; # set if parameter was passed
return $self->{_x};
}
sub y {
my $self = shift;
$self->{_y} = $_[0] if $_[0];
return $self->{_y};
}
sub coords {
my $self = shift;
#{$self}{qw(_x _y)} = #_ if #_;
return $self->{_x}, $self->{_y};
}
sub distance {
my ($self, $pt) = #_;
my ($x1, $y1) = $self->coords();
my ($x2, $y2) = $pt->coords();
return sqrt( ($x1 - $x2)**2 + ($y1 - $y2)**2 );
}
sub random {
my $self = shift;
my $range = $_[0] // 50;
$self->{_x} = int rand $range;
$self->{_y} = int rand $range;
return $self;
}
1;
The random method takes an optional range, so both $pt->random() and $pt->random(10) set random coordinates for $pt. It has default 50, set using defined-or operator, //. Since it returns the object itself you can chain methods, like
my $pt = Point->new(10, 20);
my #coords = $pt->random()->coords();
print "#coords\n";
or, since new itself also returns the object, even
my #coords = Point->new()->random(10)->coords();
This wouldn't be of much use though as we now don't get the object.
LineSegment.pm
package LineSegment;
use strict;
use warnings;
use Point;
sub new {
my $class = shift;
my $self = { };
bless $self, $class;
if (#_) { #{$self}{qw(_pA _pB)} = #_ }
else { #{$self}{qw(_pA _pB)} = (Point->new, Point->new) }
return $self;
}
sub pA {
my $self = shift;
$self->{_pA} = $_[0] if $_[0];
return $self->{_pA};
}
sub pB {
my $self = shift;
$self->{_pB} = $_[0] if $_[0];
return $self->{_pB};
}
sub pts {
my $self = shift;
#{$self}{qw(_pA _pB)} = #_ if #_;
return #{$self}{qw(_pA _pB)};
}
sub len {
my $self = shift;
return $self->{_pA}->distance($self->{_pB});
}
1;
The default in the constructor calls Point's default constructor for each point, if no arguments were passed to initialize the segment object.
The len() method doesn't need coordinates, since we added distance() method to Point. It is natural and needed in a point class and this is better than having LineSegment compute. Often we need to calculate in the class, of course. Think of mid_point (of a segment), intersection (between two segments), etc.
main.pl
use warnings 'all';
use strict;
use feature 'say';
use Point;
use LineSegment;
my $line = LineSegment->new(
Point->new(10, 20),
Point->new(30, 40),
);
my $pt_A = $line->pA( Point->new(15, 10) );
my $pt_B = $line->pB;
printf "Point A = (%d,%d)\n", $pt_A->coords();
printf "Point B = (%d,%d)\n", $pt_B->coords();
printf "Length of the segment: %.3f\n", $line->len();
my #coords = $pt_A->random(10)->coords();
say "Random point, set on existing object: #coords";
my $segm = LineSegment->new();
my #ends = $segm->pts();
print "Segment created with defaults, ends: ";
printf "(%d,%d) ", $_->coords() for #ends;
say '';
This prints
Point A = (15,10)
Point B = (30,40)
Length of the segment: 33.541
Random point, set on existing object: 3 8
Segment created with defaults, ends: (34,19) (16,14)
What is notably missing here are checks of various kinds. However, once that becomes important one should probably start looking toward Moose or the similar but much lighter Moo.
A comment on new LineSegment() syntax used in the question.
A constructor in Perl is just a method, but the one that blesses the object into the class (package). The name new is indeed common but that is merely a convention. Thus the "normal" way to call a constructor is like any other method, ClassName->new().
One can use new ClassName, which is called "indirect object notation" (or syntax). However, here is what perlobj itself has to say about it (original emphasis)
Outside of the file handle case, use of this syntax is discouraged as it can confuse the Perl interpreter. See below for more details.
Also see this post and its links, for example. Just use ClassName->new().

How do I insert new fields into $self in Perl, from a File::Find callback

In a Perl object, I'm trying to add a new field into $self from within a File::Find wanted() sub.
use File::Find;
sub _searchForXMLDocument {
my ($self) = #_;
if($_ =~ /[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
}
sub runIt{
my ($self) = #_;
find (\&_searchForXMLDocument, $self->{_path});
print $self->{_xmlDocumentPath};
}
_searchForXMLDocument() searches for an XML Document within $self->{_path} and is supposed to append that XML path to $self->{_xmlDocumentPath} but when I try to print it, it remains uninitialized. How do I add the field in $self?
Use of uninitialized value in print at /home/scott/workspace/CCGet/XMLProcessor.pm line 51.
You aren't calling _searchForXMLDocument() in an OO manner, so your $self object isn't being passed to it. This should do the trick now. Use a closure for your method and you have access to $self;
sub runIt{
my ($self) = #_;
my $closure = sub {
if($_ !~ m/[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
};
find(\&$closure, $self->{_path});
print $self->{_xmlDocumentPath};
}
The first argument to find() needs to carry two pieces of information: the test condition, and the object you're working with. The way to do this is with a closure. The sub { ... } creates a code ref, like you get from \&_searchForXMLDocument, but the closure has access to lexical variables in the enclosing scope, so the current object ($self) is associated with the closure.
sub _searchForXMLDocument {
my ($self) = #_;
if($_ =~ /[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
}
sub runIt{
my ($self) = #_;
find (sub { $self->_searchForXMLDocument (#_) }, $self->{_path});
print $self->{_xmlDocumentPath};
}
I think you're looking for something like this:
package XMLDocThing;
use strict;
use warnings;
use English qw<$EVAL_ERROR>;
use File::Find qw<find>;
...
use constant MY_BREAK = do { \my $v = 133; };
sub find_XML_document {
my $self = shift;
eval {
find( sub {
return unless m/[.]+\.xml/;
$self->{_xmlDocumentPath} = $_;
die MY_BREAK;
}
, $self->{_path}
);
};
if ( my $error = $EVAL_ERROR ) {
die Carp::longmess( $EVAL_ERROR ) unless $error == MY_BREAK;
}
}
...
# meanwhile, in some other package...
$xmldocthing->find_XML_document;
You pass a closure to find and it can access $self from the containing scope. File::Find::find has no capacity to pass in baggage like objects.

Why is the parameter variable empty?

I have a Perl controller class in which I do:
sub func1 {
my $f1 = Model::myModel->new();
my $param = "test";
$f1->func2($param);
}
Model class:
sub new {
my ($class, %arg) = #_;
my $self = bless {}, $class;
return $self;
}
sub func2 {
my ($self, $param) = shift(#_);
warn $param;
}
$param is blank. What is the mistake I am doing?
shift only shifts the first value off of #_. perldoc -f shift will tell you more about how shift works.
You want:
my( $self, $param ) = #_;
You had it right in new(). Not sure what happened ;)
Actually, FYI, your new() will give the warning:
Odd number of elements in hash assignment
If you call it like $package->new( 'a' ); You might want to trap that, something like:
use Carp qw( croak confess );
sub new {
my $class = shift;
confess "$class requires an even number of args" if( #_ & 1 );
my %args = #_;
# ...
}
Or using whatever exception catching mechanism you use.
Try:
sub func2 {
my ( $self, $param ) = #_;
warn $param;
}
or
sub func2 {
my $self = shift #_;
my $param = shift #_;
warn $param;
}

Can't locate object method "add" via package "Heap"

I'm not sure why perl isn't recognizing the Heap's method add. Getting message given in question title. Here are the most relevant files.
#!/usr/bin/perl -w
use strict;
use Util;
use Heap;
use HuffTree;
my $heap = Heap->new;
my $test = 3;
$heap->add($test); # <--------ERROR HERE-----------
package Heap;
use strict;
use warnings;
use POSIX ();
sub new {
my $class = shift;
my $self = { "aref" => [""],
"next" => 1,
#_};
bless $self, $class;
}
sub print {
my $self = shift;
my $next = $self->{"next"};
my $aref = $self->{"aref"};
print "array => #$aref\n";
print "next => $next\n";
}
sub compare {
my ($self, $i, $j) = #_;
my $x = $self->{"aref"}[$i];
my $y = $self->{"aref"}[$j];
if (!defined $x) {
if (!defined $y) {
return 0;
} else {
return -1;
}
}
return 1 if !defined $y;
return $x->priority <=> $y->priority;
}
sub swap {
my ($self, $i, $j) = #_;
my $aref = $self->{"aref"};
($aref->[$i], $aref->[$j]) = ($aref->[$j], $aref->[$i]);
}
sub add {
my ($self, $value) = #_;
my $i = $self->{"next"};
$self->{"aref"}[$i] = $value;
while ($i > 1) {
my $parent = POSIX::floor($i/2);
last if $self->compare($i, $parent) <= 0;
$self->swap($i, $parent);
$i = $parent;
}
$self->{"next"}++;
}
sub reheapify {
my ($self, $i) = #_;
my $left = 2 * $i;
my $right = 2 * $i + 1;
my $winleft = $self->compare($i, $left) >= 0;
my $winright = $self->compare($i, $right) >= 0;
return if $winleft and $winright;
if ($self->compare ($left, $right) > 0) {
$self->swap($i, $left);
$self->reheapify($left);
} else {
$self->swap($i, $right);
$self->reheapify($right);
}
}
sub remove {
my $self = shift;
my $aref = $self->{"aref"};
my $result = $aref->[1];
$aref->[1] = pop #$aref;
$self->{"next"}--;
$self->reheapify(1);
return $result;
}
sub empty {
my $self = shift;
return $self->{"next"} == 1;
}
1;
package HuffTree;
use warnings;
use strict;
use Pair;
our #ISA = "Pair";
sub priority {
my $self = shift;
# lowest count highest priority
return -$self->{frequency};
}
sub left {
my $self = shift;
return $self->{left};
}
sub right {
my $self = shift;
return $self->{right};
}
1;
package Pair;
use warnings;
use strict;
sub new {
my $class = shift;
my $self = { #_ };
bless $self, $class;
}
sub letter {
my $self = shift;
return $self->{letter};
}
sub frequency {
my $self = shift;
return $self->{frequency};
}
sub priority {
my $self = shift;
return $self->{frequency};
}
1;
package Util;
use strict;
use warnings;
sub croak { die "$0: #_: $!\n"; }
sub load_arg_file {
my $path_name = shift #ARGV;
my $fh;
open($fh, $path_name) || croak "File not found.\n";
return $fh;
}
1;
You have a Heap.pm installed from CPAN. That's what gets loaded, not your own Heap.pm. The new sub in the Heap.pm from CPAN looks like this:
sub new {
use Heap::Fibonacci;
return &Heap::Fibonacci::new;
}
Which is actually a bug in said module, because Heap::Fibonacci uses the
standard bless \$h, $class; thing in its new sub,
so the reference is blessed into the Heap package, which
does indeed not have a sub called add (Heap::Fibonacci does).
To solve your immediate problem, you can:
make sure that your module is picked up before the "other" Heap (by modifying #INC with use lib, for example;
or not reinvent the wheel and actually use Heap::Fibonacci).
At any rate, it might be a good idea to report this problem
to the Heap module author - because even if you did not have
your own Heap.pm, your code would still fail with the same message.