File Coverage

blib/lib/Business/Bitcoin/Request.pm

Criterion	Covered	Total	%
statement	30	46	65.2
branch	6	22	27.2
condition	1	3	33.3
subroutine	6	8	75.0
pod	2	2	100.0
total	45	81	55.5

# -*-cperl-*-
#
# Business::Bitcoin::Request - Bitcoin payment request
# Copyright (c) 2016 Ashish Gulhati
#
# $Id: lib/Business/Bitcoin/Request.pm v1.7 Thu Dec 29 11:03:49 2016 -0500 $

use strict;

package Business::Bitcoin::Request;
use DBI;
use LWP::UserAgent;
use HTTP::Request;

use vars qw( $VERSION $AUTOLOAD );

our ( $VERSION ) = '$Revision: 1.7 $' =~ /\s+([\d\.]+)/;

sub new {
  my $class = shift; my %args = @_;
  return undef if $args{Amount} !~ /^\d+$/; return undef if $args{StartIndex} and $args{StartIndex} =~ /\D/;
  my $db = $args{_BizBTC}->db; my $xpub = $args{_BizBTC}->xpub; my $ku = $args{_BizBTC}->kucmd;
  my $timestamp = time; my $index;
  my $index = defined $args{StartIndex} ? $args{StartIndex} : 'NULL';
  my $refid = defined $args{Ref} ? "'$args{Ref}'" : 'NULL';
  return undef unless $db->do("INSERT INTO requests values ($index, '$args{Amount}', NULL, $refid, '$timestamp');");
  $index = $db->last_insert_id('%', '%', 'requests', 'reqid');
  $ENV{PATH} = undef;
  return undef unless my $address = `$ku $xpub -s 0/$index -a`; chomp $address;
  my $rows = $db->do("UPDATE requests set address='$address' where reqid='$index';");
  bless { Address => $address,
	  Amount => $args{Amount},
	  Ref => $args{Ref},
	  Confirmations => defined $args{Confirmations} ? $args{Confirmations} : 5,
	  Created => $timestamp }, $class;
}

sub verify {
  my $self = shift;
  my $ua = new LWP::UserAgent;
  my $req = HTTP::Request->new(GET => 'https://blockchain.info/q/addressbalance/' . $self->address . '?confirmations=' . $self->confirmations);
  my $res = $ua->request($req);
  $res->content == $self->amount;
}

sub AUTOLOAD {
  my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
  return if $auto eq 'DESTROY';
  if ($auto =~ /^(confirmations)$/x) {
    $self->{"\u$auto"} = shift if (defined $_[0]);
  }
  if ($auto =~ /^(amount|address|ref|version|created|confirmations)$/x) {
    return $self->{"\u$auto"};
  }
  else {
    die "Could not AUTOLOAD method $auto.";
  }
}

1; # End of Business::Bitcoin::Request

=head1 NAME

Business::Bitcoin::Request - Bitcoin payment request

=head1 VERSION

 $Revision: 1.7 $
 $Date: Thu Dec 29 11:03:49 2016 -0500 $

=head1 SYNOPSIS

Business::Bitcoin::Request objects represent Bitcoin payment requests
generated by Business::Bitcoin.

    use Business::Bitcoin;

    my $bizbtc = new Business::Bitcoin (DB => '/tmp/bizbtc.db',
                                        XPUB => 'xpub...');

    my $request = $bizbtc->request(Amount => 4200);

    print ($request->verify ? "Verified\n" : "Verification failed\n");

=head1 METHODS

=head2 new

Not intended to be called directly. Business::Bitcoin::Request objects
should be created by calling the request method on a Business::Bitcoin
object.

=head2 verify

Verify that the request has been paid. Returns true if the request has
been paid, false otherwise. The number of confirmations required to
consider a payment valid can be set via the confirmations accessor.

=head1 ACCESSORS

Accessors can be called with no arguments to query the value of an
object property, or with a single argument, to set the property to a
specific value (unless the property is read only).

=head2 confirmations

The number of confirmations needed to consider a payment valid.

=head2 amount

The amount of the payment request, in Satoshi. Read only.

=head2 address

The Bitcoin receiving address for the payment request. Read only.

=head2 created

The timestamp of when the request was created. Read only.

=head2 ref

An optional reference ID for the request, to facilitate integration
with existing order systems. Read only.

=head2 version

The version number of this module. Read only.

=head1 AUTHOR

Ashish Gulhati, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Business::Bitcoin::Request

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2016 Ashish Gulhati. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.