multi-currency, RT#21565

9 files changed, 567 insertions, 8 deletions

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index c85e4a5..982c340 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -5,6 +5,7 @@ use Carp;
 use IO::File;
 use File::Basename;
 use MIME::Base64;
+use Locale::Currency;
 use FS::ConfItem;
 use FS::ConfDefaults;
 use FS::Conf_compat17;
@@ -1006,12 +1007,25 @@ sub reason_type_options {
   {
     'key'         => 'currency',
     'section'     => 'billing',
-    'description' => 'Currency',
+    'description' => 'Main accounting currency',
     'type'        => 'select',
     'select_enum' => [ '', qw( USD AUD CAD DKK EUR GBP ILS JPY NZD XAF ) ],
   },
 
   {
+    'key'         => 'currencies',
+    'section'     => 'billing',
+    'description' => 'Additional accepted currencies',
+    'type'        => 'select-sub',
+    'multiple'    => 1,
+    'options_sub' => sub { 
+                           map { $_ => code2currency($_) } all_currency_codes();
+			 },
+    'sort_sub'    => sub ($$) { $_[0] cmp $_[1]; },
+    'option_sub'  => sub { code2currency(shift); },
+  },
+
+  {
     'key'         => 'business-batchpayment-test_transaction',
     'section'     => 'billing',
     'description' => 'Turns on the Business::BatchPayment test_mode flag.  Note that not all gateway modules support this flag; if yours does not, using the batch gateway will fail.',
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 90ced1f..6c12e81 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -121,6 +121,8 @@ if ( -e $addl_handler_use_file ) {
   use HTML::Widgets::SelectLayers 0.07; #should go away in favor of
                                         #selectlayers.html
   use Locale::Country;
+  use Locale::Currency;
+  use Locale::Currency::Format;
   use Business::US::USPS::WebTools::AddressStandardization;
   use Geo::GoogleEarth::Pluggable;
   use LWP::UserAgent;
@@ -341,6 +343,9 @@ if ( -e $addl_handler_use_file ) {
   use FS::part_pkg_msgcat;
   use FS::svc_cable;
   use FS::cable_device;
+  use FS::agent_currency;
+  use FS::currency_exchange;
+  use FS::part_pkg_currency;
   # Sammath Naur
 
   if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index cdbcae0..be35521 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -12,19 +12,19 @@ use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use Scalar::Util qw( blessed );
+use File::Slurp qw( slurp );
 use File::CounterFile;
-use Locale::Country;
 use Text::CSV_XS;
-use File::Slurp qw( slurp );
 use DBI qw(:sql_types);
 use DBIx::DBSchema 0.38;
+use Locale::Country;
+use Locale::Currency;
+use NetAddr::IP; # for validation
 use FS::UID qw(dbh datasrc driver_name);
 use FS::CurrentUser;
 use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
-use NetAddr::IP; # for validation
-use Data::Dumper;
 #use FS::Conf; #dependency loop bs, in install_callback below instead
 
 use FS::part_virtual_field;
@@ -1528,6 +1528,7 @@ csv, xls, fixedlength, xml
 
 =cut
 
+use Data::Dumper;
 sub batch_import {
   my $param = shift;
 
@@ -2129,6 +2130,41 @@ sub ut_moneyn {
   $self->ut_money($field);
 }
 
+=item ut_currencyn COLUMN
+
+Check/untaint currency indicators, such as USD or EUR.  May be null.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_currencyn {
+  my($self, $field) = @_;
+  if ($self->getfield($field) eq '') { #can be null
+    $self->setfield($field, '');
+    return '';
+  }
+  $self->ut_currency($field);
+}
+
+=item ut_currency COLUMN
+
+Check/untaint currency indicators, such as USD or EUR.  May not be null.  If
+there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_currency {
+  my($self, $field) = @_;
+  my $value = uc( $self->getfield($field) );
+  if ( code2currency($value) ) {
+    $self->setfield($value);
+  } else {
+    return "Unknown currency $value";
+  }
+
+  '';
+}
+
 =item ut_text COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 71d84cc..0487186 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -533,6 +533,17 @@ sub tables_hashref {
       'index' => [ ['salesnum'], ['disabled'] ],
     },
 
+    'agent_currency' => {
+      'columns' => [
+        'agentcurrencynum', 'serial', '', '', '', '',
+        'agentnum',            'int', '', '', '', '',
+        'currency',           'char', '',  3, '', '',
+      ],
+      'primary_key' => 'agentcurrencynum',
+      'unique'      => [],
+      'index'       => [ ['agentnum'] ],
+    },
+
     'cust_attachment' => {
       'columns' => [
         'attachnum', 'serial', '', '', '', '',
@@ -2054,6 +2065,31 @@ sub tables_hashref {
       'index'       => [],
     },
 
+    'part_pkg_currency' => {
+      'columns' => [
+        'pkgcurrencynum', 'serial', '',      '', '', '',
+        'pkgpart',           'int', '',      '', '', '',
+        'currency',         'char', '',       3, '', '',
+        'optionname',    'varchar', '', $char_d, '', '', 
+        'optionvalue',      'text', '',      '', '', '', 
+      ],
+      'primary_key' => 'pkgcurrencynum',
+      'unique'      => [ [ 'pkgpart', 'currency', 'optionname' ] ],
+      'index'       => [ ['pkgpart'] ],
+    },
+
+    'currency_exchange' => {
+      'columns' => [
+        'currencyratenum', 'serial', '',    '', '', '',
+        'from_currency',     'char', '',     3, '', '',
+        'to_currency',       'char', '',     3, '', '',
+        'rate',           'decimal', '', '7,6', '', '',
+      ],
+      'primary_key' => 'currencyratenum',
+      'unique'      => [ [ 'from_currency', 'to_currency' ] ],
+      'index'       => [],
+    },
+
     'part_pkg_link' => {
       'columns' => [
         'pkglinknum',  'serial',   '',      '', '', '',
diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm
index 9b32209..109343a 100644
--- a/FS/FS/agent.pm
+++ b/FS/FS/agent.pm
@@ -1,19 +1,18 @@
 package FS::agent;
+use base qw( FS::m2m_Common FS::m2name_Common FS::Record );
 
 use strict;
 use vars qw( @ISA );
-#use Crypt::YAPassGen;
 use Business::CreditCard 0.28;
 use FS::Record qw( dbh qsearch qsearchs );
 use FS::cust_main;
 use FS::cust_pkg;
 use FS::agent_type;
+use FS::agent_currency;
 use FS::reg_code;
 use FS::TicketSystem;
 use FS::Conf;
 
-@ISA = qw( FS::m2m_Common FS::Record );
-
 =head1 NAME
 
 FS::agent - Object methods for agent records
@@ -177,6 +176,31 @@ sub agent_cust_main {
   qsearchs( 'cust_main', { 'custnum' => $self->agent_custnum } );
 }
 
+=item agent_currency
+
+Returns the FS::agent_currency objects (see L<FS::agent_currency>), if any, for
+this agent.
+
+=cut
+
+sub agent_currency {
+  my $self = shift;
+  qsearch('agent_currency', { 'agentnum' => $self->agentnum } );
+}
+
+=item agent_currency_hashref
+
+Returns a hash references of supported additional currencies for this agent.
+
+=cut
+
+sub agent_currency_hashref {
+  my $self = shift;
+  +{ map { $_->currency => 1 }
+       $self->agent_currency
+   };
+}
+
 =item pkgpart_hashref
 
 Returns a hash reference.  The keys of the hash are pkgparts.  The value is
diff --git a/FS/FS/agent_currency.pm b/FS/FS/agent_currency.pm
new file mode 100644
index 0000000..e387844
--- /dev/null
+++ b/FS/FS/agent_currency.pm
@@ -0,0 +1,110 @@
+package FS::agent_currency;
+use base qw( FS::Record );
+
+use strict;
+#use FS::Record qw( qsearch qsearchs );
+use FS::agent;
+
+=head1 NAME
+
+FS::agent_currency - Object methods for agent_currency records
+
+=head1 SYNOPSIS
+
+  use FS::agent_currency;
+
+  $record = new FS::agent_currency \%hash;
+  $record = new FS::agent_currency { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::agent_currency object represents an agent's ability to sell
+in a specific non-default currency.  FS::agent_currency inherits from
+FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item agentcurrencynum
+
+primary key
+
+=item agentnum
+
+Agent (see L<FS::agent>)
+
+=item currency
+
+3 letter currency code
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record.  To add the record to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+sub table { 'agent_currency'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database.
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid record.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('agentcurrencynum')
+    || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
+    || $self->ut_currency('currency')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::agent>
+
+=cut
+
+1;
+
diff --git a/FS/FS/currency_exchange.pm b/FS/FS/currency_exchange.pm
new file mode 100644
index 0000000..68832b6
--- /dev/null
+++ b/FS/FS/currency_exchange.pm
@@ -0,0 +1,116 @@
+package FS::currency_exchange;
+use base qw( FS::Record );
+
+use strict;
+#use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::currency_exchange - Object methods for currency_exchange records
+
+=head1 SYNOPSIS
+
+  use FS::currency_exchange;
+
+  $record = new FS::currency_exchange \%hash;
+  $record = new FS::currency_exchange { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::currency_exchange object represents an exchange rate between currencies.
+FS::currency_exchange inherits from FS::Record.  The following fields are
+currently supported:
+
+=over 4
+
+=item currencyratenum
+
+primary key
+
+=item from_currency
+
+from_currency
+
+=item to_currency
+
+to_currency
+
+=item rate
+
+rate
+
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new exchange rate.  To add the exchange rate to the database, see
+L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+sub table { 'currency_exchange'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database.
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid exchange rate.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('currencyratenum')
+    || $self->ut_currency('from_currency')
+    || $self->ut_currency('to_currency')
+    || $self->ut_float('rate') #good enough for untainting
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 605c84f..67372ac 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -25,6 +25,7 @@ use FS::part_pkg_link;
 use FS::part_pkg_discount;
 use FS::part_pkg_usage;
 use FS::part_pkg_vendor;
+use FS::part_pkg_currency;
 
 $DEBUG = 0;
 $setup_hack = 0;
@@ -177,6 +178,9 @@ records will be inserted.
 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
 records will be inserted.
 
+If I<part_pkg_currency> is set to a hashref of options (with the keys as
+option_CURRENCY), appropriate FS::part_pkg::currency records will be inserted.
+
 =cut
 
 sub insert {
@@ -251,6 +255,23 @@ sub insert {
     }
   }
 
+  warn "  inserting part_pkg_currency records" if $DEBUG;
+  my %part_pkg_currency = %{ $options{'part_pkg_currency'} || {} };
+  foreach my $key ( keys %part_pkg_currency ) {
+    $key =~ /^(.+)_([A-Z]{3})$/ or next;
+    my $part_pkg_currency = new FS::part_pkg_currency {
+      'pkgpart'     => $self->pkgpart,
+      'optionname'  => $1,
+      'currency'    => $2,
+      'optionvalue' => $part_pkg_currency{$key},
+    };
+    my $error = $part_pkg_currency->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
   unless ( $skip_pkg_svc_hack ) {
 
     warn "  inserting pkg_svc records" if $DEBUG;
@@ -352,6 +373,9 @@ FS::pkg_svc record will be updated.
 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
 will be replaced.
 
+If I<part_pkg_currency> is set to a hashref of options (with the keys as
+option_CURRENCY), appropriate FS::part_pkg::currency records will be replaced.
+
 =cut
 
 sub replace {
@@ -447,6 +471,34 @@ sub replace {
     }
   }
 
+  #trivial nit: not the most efficient to delete and reinsert
+  warn "  deleting old part_pkg_currency records" if $DEBUG;
+  foreach my $part_pkg_currency ( $old->part_pkg_currency ) {
+    my $error = $part_pkg_currency->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error deleting part_pkg_currency record: $error";
+    }
+  }
+
+  warn "  inserting new part_pkg_currency records" if $DEBUG;
+  my %part_pkg_currency = %{ $options->{'part_pkg_currency'} || {} };
+  foreach my $key ( keys %part_pkg_currency ) {
+    $key =~ /^(.+)_([A-Z]{3})$/ or next;
+    my $part_pkg_currency = new FS::part_pkg_currency {
+      'pkgpart'     => $new->pkgpart,
+      'optionname'  => $1,
+      'currency'    => $2,
+      'optionvalue' => $part_pkg_currency{$key},
+    };
+    my $error = $part_pkg_currency->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error inserting part_pkg_currency record: $error";
+    }
+  }
+
+
   warn "  replacing pkg_svc records" if $DEBUG;
   my $pkg_svc = $options->{'pkg_svc'};
   my $hidden_svc = $options->{'hidden_svc'} || {};
@@ -1191,6 +1243,33 @@ sub option {
   '';
 }
 
+=item part_pkg_currency [ CURRENCY ]
+
+Returns all currency options as FS::part_pkg_currency objects (see
+L<FS::part_pkg_currency>), or, if a currency is specified, only return the
+objects for that currency.
+
+=cut
+
+sub part_pkg_currency {
+  my $self = shift;
+  my %hash = ( 'pkgpart' => $self->pkgpart );
+  $hash{'currency'} = shift if @_;
+  qsearch('part_pkg_currency', \%hash );
+}
+
+=item part_pkg_currency_options CURRENCY
+
+Returns a list of option names and values from FS::part_pkg_currency for the
+specified currency.
+
+=cut
+
+sub part_pkg_currency_options {
+  my $self = shift;
+  map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift);
+}
+
 =item bill_part_pkg_link
 
 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
diff --git a/FS/FS/part_pkg_currency.pm b/FS/FS/part_pkg_currency.pm
new file mode 100644
index 0000000..246abee
--- /dev/null
+++ b/FS/FS/part_pkg_currency.pm
@@ -0,0 +1,139 @@
+package FS::part_pkg_currency;
+use base qw( FS::Record );
+
+use strict;
+#use FS::Record qw( qsearch qsearchs );
+use FS::part_pkg;
+
+=head1 NAME
+
+FS::part_pkg_currency - Object methods for part_pkg_currency records
+
+=head1 SYNOPSIS
+
+  use FS::part_pkg_currency;
+
+  $record = new FS::part_pkg_currency \%hash;
+  $record = new FS::part_pkg_currency { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_pkg_currency object represents an example.  FS::part_pkg_currency inherits from
+FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item pkgcurrencynum
+
+primary key
+
+=item pkgpart
+
+Package definition (see L<FS::part_pkg>).
+
+=item currency
+
+3-letter currency code
+
+=item optionname
+
+optionname
+
+=item optionvalue
+
+optionvalue
+
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example.  To add the example to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'part_pkg_currency'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('pkgcurrencynum')
+    || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
+    || $self->ut_currency('currency')
+    || $self->ut_text('optionname')
+    || $self->ut_textn('optionvalue')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+