[ic] need help getting custom pm to work

[Christian Brink]

> 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