view release on metacpan or  search on metacpan

TB.pm  view on Meta::CPAN

##############################################################################
#                                                                            #
#  Copyright (c) 2000-2008 Jan 'Kozo' Vajda <Jan.Vajda@alert.sk>             #
#  All rights reserved.                                                      #
#                                                                            #
##############################################################################

package Finance::Bank::TB;
require Exporter;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;
use Digest::SHA1;
use Crypt::DES 2.03;

### my initial version was 0.11
$VERSION = '0.28';

@ISA = qw(Exporter);

# Items to export into callers namespace by default
@EXPORT =	qw();

# Other items we are prepared to export if requested
@EXPORT_OK =	qw();


=head1 NAME

Finance::Bank::TB - Perl extension for B<TatraPay> and B<CardPay> of
Tatrabanka and B<EliotPay> of .eliot.

=head1 VERSION

  0.28

=head1 SYNOPSIS

  use Finance::Bank::TB;

  $tb_obj = Finance::Bank::TB->new($mid,$key);

  $tb_obj->configure(
	      cs	=> $cs,
	      vs	=> $vs,
	      amt	=> $amt,
	      rurl	=> $rurl,
	      name	=> $uname,
	      ipc	=> $ip_of_client,
	      image_src => '/PICS/tatrapay_logo.gif',
  );

  my $send_sign = $tb_obj->get_send_sign();
  my $recv_sign = $tb_obj->get_recv_sign();
  my $new_cs = $tb_obj->cs($cs);
 
or

  use Finance::Bank::TB;

  $tb_obj = Finance::Bank::TB->new($mid,$key);

  $tb_obj->configure(
	      cs	=> $cs,
	      vs	=> $vs,
	      amt	=> $amt,
	      rurl	=> $rurl,
	      desc	=> $description,
	      rsms	=> $mobilephonenumber,
	      rem	=> $remote_mail,
	      name	=> $uname,
	      ipc	=> $ip_of_client,
	      image_src => '/PICS/tatrapay_logo.gif',
  );

TB.pm  view on Meta::CPAN

sub pay_link {
  my $self =shift;
  my $type = shift;
  my $action;
  my $pt = "";

  ### detection of Pay Type
  ### default null ( user select )
  
  if ( $type =~ /eliot/i ) {
    $pt = "EliotPay";
  } elsif ( $type =~ /card/i ){
    $pt = "CardPay";
  } elsif ($type =~ /tatra/i ) {
    $pt = "TatraPay";
    $self->ipc = "";
    $self->name = "";
  }

  $action = $self->{action_url};

  my $sign = $self->get_send_sign();

my $tb_form = <<EOM;
$action ?
PT=$pt &
MID=$self->{mid} & 
AMT=$self->{amt} & 
VS=$self->{vs} & 
CS=$self->{cs} & 
RURL=$self->{rurl} & 
AREDIR=$self->{aredir} & 
LANG=$self->{lang} & 
DESC=$self->{desc} & 
RSMS=$self->{rsms} & 
REM=$self->{rem} & 
IPC=$self->{ipc} & 
NAME=$self->{name} & 
SIGN=$sign 
EOM

$tb_form =~ s/\n//og;
$tb_form =~ s/\s+//og;

  return($tb_form);
}

sub _make_sign {
  my $key = shift;
  my $initstr = shift;

  ### make SHA hash
  my $context = new Digest::SHA1;
  $context->add($initstr);
  my $tb_hash = $context->digest;

  ### first 8 chars
  my $tb_hash_part = substr($tb_hash,0,8);

  ### crypting by DES
  my $cipher = Crypt::DES->new($key);
  my $tb_des = $cipher->encrypt($tb_hash_part);

  ### to hex
  my $tb_hash_hex = unpack("H16", $tb_des);

  ### convert to upper case and return
  return("\U$tb_hash_hex");
}

sub AUTOLOAD {
  my $self = shift;
  my $value = shift;
  my ($name) = $AUTOLOAD;

  ($name) = ( $name =~ /^.*::(.*)/);

  $self->{$name} = $value if ( defined $value );

  return($self->{$name});
 
}

sub DESTROY {
  ### bye bye 
}

1;

__END__

=head1 EXAMPLES

Look at B<SYNOPSIS>, B<t/*>, B<examples/*> and use the source.
(lookin for a volunteer for writing documentation and man pages)

=head1 AUTHOR INFORMATION

Copyright 2000 Jan ' Kozo ' Vajda, Jan.Vajda@alert.sk. All rights reserved.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself, but I do request that this copyright
notice remain attached to the file. You may modify this module as you wish,
but if you redistribute a modified version, please attach a note listing the
modifications you have made.

Address bug reports and comments to:
Jan.Vajda@alert.sk

=head1 CREDITS

Thanks very much to:

=over 4

=item my wife Erika & kozliatka

for patience and love

=item Gildir ( gildir@alert.sk ) 

for debugging

=item M. Sulik from TatraBanka

for documentation, C examples and mail helpdesk.

=back

=head1 SEE ALSO

  perl(1),Digest::SHA1(1),Crypt::DES(1).

=cut