[ic] need help getting custom pm to work
Christian Brink
interchange-users@icdevgroup.org
Tue Jun 3 14:47:00 2003
> package Vend::Fraud;
> use strict;
> use warnings;
>
> require Exporter;
> our @ISA = qw(Exporter);
> our @EXPORT_OK = qw( &fraudCheck );
EXPORT_OK just means you can call the sub to be imported it is not pushed
into the namespace.
eg. you would have to call the module like this:
use Vend::Fraud qw/ fraudCheck /;
If you want to do this in your module use the @EXPORT array, but I prefer
the OO interface so you're not polluting the namespace. You have already
started the OO interface just keep on going that way and ditch EXPORTER.
> our $VERSION = '0.01';
>
> sub new {
> my $self = shift;
> my $class = ref($self) || $self;
> return bless{}, $class;
> }
> sub fraudCheck {
> my $user = @_;
Right here your are using @_ in a scalar context so you get the number of
elements in @_ not the first value of @_;
You want:
my ($user) = @_;
or even better:
my $user = shift();
or for the OO interface:
my $self = shift();
my $user = shift();
> return $user;
> }
> 1;
> __END__
> </ Vend::Fraud>
Here's what I do when I want a custom tag.
I first create a module in the /usr/local/interchange/lib. In your case
create a directory /usr/local/interchange/lib/Vend/ then create the file
/usr/local/interchange/lib/Vend/Fraud.pm.
The module Fraud.pm should go something like this.
package Vend::Fraud;
use strict;
use warnings;
sub new {
my $class = shift;
my %args = @_;
# This is your constructor you passed the
# interchange db handle and the tag handle
# so you can use them if necessary.
# this creates the object perl automatically
# passes around
my $self = bless {
_tag => $args{Tag},
_db => $args{db}
}, $class;
# here you return the object
return $self;
}
# here is your sub. As a perl idiom use lc dashed notation for
# your methods/functions (Hungarian Notation is not the norm and
# is more difficult for non-native english speakers to read)
sub fraud_check {
my $self = shift(); # your object is the first thing passed
my $user = shift(); # here is your first param
my $out = '';
return 'No user' if (!$user); # Oops no user
if ( $self->check_for_fraud($user) ) {
return 'You are a fraud'; # They are a fraud
} else {
$out .= 'You passed the first check';
}
## more checks
return $out;
}
sub check_for_fraud {
my $self = shift; # Here's my object again
my $user = shift;
# the object was passing around the {_db} database handle for you to
# use. It is the same db handle from interchange.
my $ary = $self->{_db}->query( {
sql => 'SELECT count(*) as cnt FROM frauds WHERE user_id = '.$user,
hashref => 1
});
my $row = $ary->[0]; # pull the first row since there will only be 1
return $row->{cnt}; # return cnt from that row
}
1;
Now create a usertag in /usr/local/interchange/usertag/ called
fraud_check.tag:
Usertag fraud_check Order user
Usertag fraud_check PosNumber 1
Usertag fraud_check Interpolate
Usertag fraud_check Routine <<EOR
sub {
use Vend::Fraud;
my $user = shift;
my $db = Vend::Data::database_exists_ref('cat')
or die "Bad database $_???";
my $v_f = Vend::Fraud->new(
Tag => $Tag,
db => $db
);
my $out = $v_f->fraud_check($user);
return $out;
}
EOR
Then you have a nice clean tag to put in your page:
[fraud_check user="[scratch user]" ]
This method makes for very clean pages which are much easier to debug. It
also is very reusable. You can add to module and then create a new usertag
without much trouble.
I also add a feature to my modules where if I don't see the interchange db
handle I create a dbi handle straight to the database and use AUTOLOAD to
dispatch between the db and dbi style queries. This makes it very easy to
test w/o the interchange engine.
If you have more question I'd be happy to help.
HTH,
Christian 'grep' Brink
http://www.perlmonks.com/index.pl?node_id=133383