forked from brmlab/brmbar-github
945ee705c3
Uses PostgreSQL to store accounts and transactions, and Perl + Moose for the implementation. The schema is somewhat complicated, but brmburo-compatible; accounting design by TMA.
126 lines
3.7 KiB
Perl
126 lines
3.7 KiB
Perl
package BrmBar::Currency;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use v5.10;
|
|
|
|
use utf8;
|
|
use encoding::warnings;
|
|
use open qw(:encoding(UTF-8));
|
|
|
|
use Moose;
|
|
use Carp;
|
|
|
|
has 'db' => (is => 'ro', isa => 'DBI::db', required => 1);
|
|
has 'id' => (is => 'ro', isa => 'Int');
|
|
has 'name' => (is => 'ro', isa => 'Str');
|
|
|
|
|
|
# Default wallet currency
|
|
sub default {
|
|
my ($class, %opts) = @_;
|
|
|
|
return $class->load(db => $opts{db}, name => 'Kč');
|
|
}
|
|
|
|
# Constructor for existing currency
|
|
sub load {
|
|
my ($class, %opts) = @_;
|
|
|
|
defined $opts{db} or croak "db parameter missing";
|
|
|
|
if (defined $opts{id}) {
|
|
my $q = $opts{db}->prepare('SELECT name FROM currencies WHERE id = ?');
|
|
$q->execute($opts{id});
|
|
($opts{name}) = $q->fetchrow_array();
|
|
|
|
} elsif (defined $opts{name}) {
|
|
my $q = $opts{db}->prepare('SELECT id FROM currencies WHERE name = ?');
|
|
$q->execute($opts{name});
|
|
($opts{id}) = $q->fetchrow_array();
|
|
}
|
|
|
|
my $self = $class->new(%opts);
|
|
return $self;
|
|
}
|
|
|
|
# Constructor for new currency
|
|
sub create {
|
|
my ($class, %opts) = @_;
|
|
|
|
defined $opts{db} or croak "db parameter missing";
|
|
defined $opts{name} or croak "name parameter missing";
|
|
|
|
my $q = $opts{db}->prepare('INSERT INTO currencies (name) VALUES (?) RETURNING id');
|
|
$q->execute($opts{name});
|
|
($opts{id}) = $q->fetchrow_array();
|
|
|
|
my $self = $class->new(%opts);
|
|
return $self;
|
|
}
|
|
|
|
|
|
# Set exchange rate against $other (BrmBar::Currency):
|
|
# $buy is the price of $self in means of $other when buying it (into brmbar)
|
|
# $sell is the price of $self in means of $other when selling it (from brmbar)
|
|
sub set_rate {
|
|
my ($self, $other, $buy, $sell) = @_;
|
|
|
|
my $qs = $self->db()->prepare("SELECT rate FROM exchange_rates WHERE target = ? AND source = ?");
|
|
my $qu = $self->db()->prepare("UPDATE exchange_rates SET rate = ?, rate_dir = ? WHERE target = ? AND source = ?");
|
|
my $qi = $self->db()->prepare("INSERT INTO exchange_rates (target, source, rate, rate_dir) VALUES (?, ?, ?, ?)");
|
|
|
|
$qs->execute($self->id(), $other->id());
|
|
if ($qs->fetchrow_array) {
|
|
$qu->execute($buy, 'target_to_source');
|
|
} else {
|
|
$qi->execute($self->id(), $other->id(), $buy, 'target_to_source');
|
|
}
|
|
|
|
$qs->execute($other->id(), $self->id());
|
|
if ($qs->fetchrow_array) {
|
|
$qu->execute($sell, 'source_to_target');
|
|
} else {
|
|
$qi->execute($other->id(), $self->id(), $sell, 'source_to_target');
|
|
}
|
|
}
|
|
|
|
# Return ($buy, $sell) rates of $self in relation to $other (BrmBar::Currency):
|
|
# $buy is the price of $self in means of $other when buying it (into brmbar)
|
|
# $sell is the price of $self in means of $other when selling it (from brmbar)
|
|
sub rates {
|
|
my ($self, $other) = @_;
|
|
|
|
my $qs = $self->db()->prepare("SELECT rate, rate_dir FROM exchange_rates WHERE target = ? AND source = ?");
|
|
|
|
$qs->execute($self->id(), $other->id());
|
|
my ($buy_rate, $buy_rate_dir) = $qs->fetchrow_array;
|
|
defined $buy_rate or croak "unknown conversion ".$other->name()." to ".$self->name();
|
|
my $buy = $buy_rate_dir eq 'target_to_source' ? $buy_rate : 1/$buy_rate;
|
|
|
|
$qs->execute($other->id(), $self->id());
|
|
my ($sell_rate, $sell_rate_dir) = $qs->fetchrow_array;
|
|
defined $sell_rate or croak "unknown conversion ".$self->name()." to ".$other->name();
|
|
my $sell = $sell_rate_dir eq 'source_to_target' ? $sell_rate : 1/$sell_rate;
|
|
|
|
return ($buy, $sell);
|
|
};
|
|
|
|
sub convert {
|
|
my ($self, $amount, $target) = @_;
|
|
|
|
my $q = $self->db()->prepare("SELECT rate, rate_dir FROM exchange_rates WHERE target = ? AND source = ? AND valid_since <= NOW() ORDER BY valid_since ASC LIMIT 1");
|
|
$q->execute($target->id(), $self->id());
|
|
my ($rate, $rate_dir) = $q->fetchrow_array();
|
|
|
|
defined $rate or croak "unknown conversion ".$self->name()." to ".$target->name();
|
|
|
|
return $rate_dir eq 'source_to_target' ? $amount * $rate : $amount / $rate;
|
|
}
|
|
|
|
sub str {
|
|
my ($self, $amount) = @_;
|
|
return $amount . ' ' . $self->name();
|
|
}
|
|
|
|
1;
|