FS/FS/agent.pm

   1 package FS::agent;
   2 use base qw( FS::m2m_Common FS::m2name_Common FS::Record );
   3
   4 use strict;
   5 use vars qw( @ISA );
   6 use Business::CreditCard 0.28;
   7 use FS::Record qw( dbh qsearch qsearchs );
   8 use FS::cust_main;
   9 use FS::cust_pkg;
  10 use FS::agent_type;
  11 use FS::agent_currency;
  12 use FS::reg_code;
  13 use FS::TicketSystem;
  14 use FS::Conf;
  15
  16 =head1 NAME
  17
  18 FS::agent - Object methods for agent records
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::agent;
  23
  24   $record = new FS::agent \%hash;
  25   $record = new FS::agent { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35   $agent_type = $record->agent_type;
  36
  37   $hashref = $record->pkgpart_hashref;
  38   #may purchase $pkgpart if $hashref->{$pkgpart};
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::agent object represents an agent.  Every customer has an agent.  Agents
  43 can be used to track things like resellers or salespeople.  FS::agent inherits
  44 from FS::Record.  The following fields are currently supported:
  45
  46 =over 4
  47
  48 =item agentnum - primary key (assigned automatically for new agents)
  49
  50 =item agent - Text name of this agent
  51
  52 =item typenum - Agent type (see L<FS::agent_type>)
  53
  54 =item ticketing_queueid - Ticketing Queue
  55
  56 =item invoice_template - Invoice template name
  57
  58 =item agent_custnum - Optional agent customer (see L<FS::cust_main>)
  59
  60 =item disabled - Disabled flag, empty or 'Y'
  61
  62 =item prog - Deprecated (never used)
  63
  64 =item freq - Deprecated (never used)
  65
  66 =item username - (Deprecated) Username for the Agent interface
  67
  68 =item _password - (Deprecated) Password for the Agent interface
  69
  70 =back
  71
  72 =head1 METHODS
  73
  74 =over 4
  75
  76 =item new HASHREF
  77
  78 Creates a new agent.  To add the agent to the database, see L<"insert">.
  79
  80 =cut
  81
  82 sub table { 'agent'; }
  83
  84 =item insert
  85
  86 Adds this agent to the database.  If there is an error, returns the error,
  87 otherwise returns false.
  88
  89 =item delete
  90
  91 Deletes this agent from the database.  Only agents with no customers can be
  92 deleted.  If there is an error, returns the error, otherwise returns false.
  93
  94 =cut
  95
  96 sub delete {
  97   my $self = shift;
  98
  99   return "Can't delete an agent with customers!"
 100     if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } );
 101
 102   $self->SUPER::delete;
 103 }
 104
 105 =item replace OLD_RECORD
 106
 107 Replaces OLD_RECORD with this one in the database.  If there is an error,
 108 returns the error, otherwise returns false.
 109
 110 =item check
 111
 112 Checks all fields to make sure this is a valid agent.  If there is an error,
 113 returns the error, otherwise returns false.  Called by the insert and replace
 114 methods.
 115
 116 =cut
 117
 118 sub check {
 119   my $self = shift;
 120
 121   my $error =
 122     $self->ut_numbern('agentnum')
 123       || $self->ut_text('agent')
 124       || $self->ut_number('typenum')
 125       || $self->ut_numbern('freq')
 126       || $self->ut_textn('prog')
 127       || $self->ut_textn('invoice_template')
 128       || $self->ut_foreign_keyn('agent_custnum', 'cust_main', 'custnum' )
 129   ;
 130   return $error if $error;
 131
 132   if ( $self->dbdef_table->column('disabled') ) {
 133     $error = $self->ut_enum('disabled', [ '', 'Y' ] );
 134     return $error if $error;
 135   }
 136
 137   if ( $self->dbdef_table->column('username') ) {
 138     $error = $self->ut_alphan('username');
 139     return $error if $error;
 140     if ( length($self->username) ) {
 141       my $conflict = qsearchs('agent', { 'username' => $self->username } );
 142       return 'duplicate agent username (with '. $conflict->agent. ')'
 143         if $conflict && $conflict->agentnum != $self->agentnum;
 144       $error = $self->ut_text('password'); # ut_text... arbitrary choice
 145     } else {
 146       $self->_password('');
 147     }
 148   }
 149
 150   return "Unknown typenum!"
 151     unless $self->agent_type;
 152
 153   $self->SUPER::check;
 154 }
 155
 156 =item agent_type
 157
 158 Returns the FS::agent_type object (see L<FS::agent_type>) for this agent.
 159
 160 =cut
 161
 162 sub agent_type {
 163   my $self = shift;
 164   qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
 165 }
 166
 167 =item agent_cust_main
 168
 169 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
 170 agent.
 171
 172 =cut
 173
 174 sub agent_cust_main {
 175   my $self = shift;
 176   qsearchs( 'cust_main', { 'custnum' => $self->agent_custnum } );
 177 }
 178
 179 =item agent_currency
 180
 181 Returns the FS::agent_currency objects (see L<FS::agent_currency>), if any, for
 182 this agent.
 183
 184 =cut
 185
 186 sub agent_currency {
 187   my $self = shift;
 188   qsearch('agent_currency', { 'agentnum' => $self->agentnum } );
 189 }
 190
 191 =item agent_currency_hashref
 192
 193 Returns a hash references of supported additional currencies for this agent.
 194
 195 =cut
 196
 197 sub agent_currency_hashref {
 198   my $self = shift;
 199   +{ map { $_->currency => 1 }
 200        $self->agent_currency
 201    };
 202 }
 203
 204 =item pkgpart_hashref
 205
 206 Returns a hash reference.  The keys of the hash are pkgparts.  The value is
 207 true if this agent may purchase the specified package definition.  See
 208 L<FS::part_pkg>.
 209
 210 =cut
 211
 212 sub pkgpart_hashref {
 213   my $self = shift;
 214   $self->agent_type->pkgpart_hashref;
 215 }
 216
 217 =item ticketing_queue
 218
 219 Returns the queue name corresponding with the id from the I<ticketing_queueid>
 220 field, or the empty string.
 221
 222 =cut
 223
 224 sub ticketing_queue {
 225   my $self = shift;
 226   FS::TicketSystem->queue($self->ticketing_queueid);
 227 };
 228
 229 =item payment_gateway [ OPTION => VALUE, ... ]
 230
 231 Returns a payment gateway object (see L<FS::payment_gateway>) for this agent.
 232
 233 Currently available options are I<nofatal>, I<invnum>, I<method>, and I<payinfo>.
 234
 235 If I<nofatal> is set, and no gateway is available, then the empty string
 236 will be returned instead of throwing a fatal exception.
 237
 238 If I<invnum> is set to the number of an invoice (see L<FS::cust_bill>) then
 239 an attempt will be made to select a gateway suited for the taxes paid on
 240 the invoice.
 241
 242 The I<method> and I<payinfo> options can be used to influence the choice
 243 as well.  Presently only 'CC', 'ECHECK', and 'PAYPAL' methods are meaningful.
 244
 245 When the I<method> is 'CC' then the card number in I<payinfo> can direct
 246 this routine to route to a gateway suited for that type of card.
 247
 248 =cut
 249
 250 sub payment_gateway {
 251   my ( $self, %options ) = @_;
 252
 253   my $taxclass = '';
 254   if ( $options{invnum} ) {
 255
 256     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{invnum} } );
 257     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
 258
 259     my @part_pkg =
 260       map  { $_->part_pkg }
 261       grep { $_ }
 262       map  { $_->cust_pkg }
 263       $cust_bill->cust_bill_pkg;
 264
 265     my @taxclasses = map $_->taxclass, @part_pkg;
 266
 267     $taxclass = $taxclasses[0]
 268       unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
 269                                                         #different taxclasses
 270   }
 271
 272   #look for an agent gateway override first
 273   my $cardtype = '';
 274   if ( $options{method} ) {
 275     if ( $options{method} eq 'CC' && $options{payinfo} ) {
 276       $cardtype = cardtype($options{payinfo});
 277     } elsif ( $options{method} eq 'ECHECK' ) {
 278       $cardtype = 'ACH';
 279     } elsif ( $options{method} eq 'PAYPAL' ) {
 280       $cardtype = 'PayPal';
 281     } else {
 282       $cardtype = $options{method}
 283     }
 284   }
 285
 286   my $override =
 287        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 288                                            cardtype => $cardtype,
 289                                            taxclass => $taxclass,       } )
 290     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 291                                            cardtype => '',
 292                                            taxclass => $taxclass,       } )
 293     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 294                                            cardtype => $cardtype,
 295                                            taxclass => '',              } )
 296     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 297                                            cardtype => '',
 298                                            taxclass => '',              } );
 299
 300   my $payment_gateway;
 301   my $conf = new FS::Conf;
 302   if ( $override ) { #use a payment gateway override
 303
 304     $payment_gateway = $override->payment_gateway;
 305
 306     $payment_gateway->gateway_namespace('Business::OnlinePayment')
 307       unless $payment_gateway->gateway_namespace;
 308
 309   } else { #use the standard settings from the config
 310
 311     # the standard settings from the config could be moved to a null agent
 312     # agent_payment_gateway referenced payment_gateway
 313
 314     unless ( $conf->exists('business-onlinepayment') ) {
 315       if ( $options{'nofatal'} ) {
 316         return '';
 317       } else {
 318         die "Real-time processing not enabled\n";
 319       }
 320     }
 321
 322     #load up config
 323     my $bop_config = 'business-onlinepayment';
 324     $bop_config .= '-ach'
 325       if ( $options{method}
 326            && $options{method} =~ /^(ECHECK|CHEK)$/
 327            && $conf->exists($bop_config. '-ach')
 328          );
 329     my ( $processor, $login, $password, $action, @bop_options ) =
 330       $conf->config($bop_config);
 331     $action ||= 'normal authorization';
 332     pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
 333     die "No real-time processor is enabled - ".
 334         "did you set the business-onlinepayment configuration value?\n"
 335       unless $processor;
 336
 337     $payment_gateway = new FS::payment_gateway;
 338
 339     $payment_gateway->gateway_namespace( $conf->config('business-onlinepayment-namespace') ||
 340                                  'Business::OnlinePayment');
 341     $payment_gateway->gateway_module($processor);
 342     $payment_gateway->gateway_username($login);
 343     $payment_gateway->gateway_password($password);
 344     $payment_gateway->gateway_action($action);
 345     $payment_gateway->set('options', [ @bop_options ]);
 346
 347   }
 348
 349   unless ( $payment_gateway->gateway_namespace ) {
 350     $payment_gateway->gateway_namespace(
 351       scalar($conf->config('business-onlinepayment-namespace'))
 352       || 'Business::OnlinePayment'
 353     );
 354   }
 355
 356   $payment_gateway;
 357 }
 358
 359 =item num_prospect_cust_main
 360
 361 Returns the number of prospects (customers with no packages ever ordered) for
 362 this agent.
 363
 364 =cut
 365
 366 sub num_prospect_cust_main {
 367   shift->num_sql(FS::cust_main->prospect_sql);
 368 }
 369
 370 sub num_sql {
 371   my( $self, $sql ) = @_;
 372   my $statement = "SELECT COUNT(*) FROM cust_main WHERE agentnum = ? AND $sql";
 373   my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
 374   $sth->execute($self->agentnum) or die $sth->errstr. " executing $statement";
 375   $sth->fetchrow_arrayref->[0];
 376 }
 377
 378 =item prospect_cust_main
 379
 380 Returns the prospects (customers with no packages ever ordered) for this agent,
 381 as cust_main objects.
 382
 383 =cut
 384
 385 sub prospect_cust_main {
 386   shift->cust_main_sql(FS::cust_main->prospect_sql);
 387 }
 388
 389 sub cust_main_sql {
 390   my( $self, $sql ) = @_;
 391   qsearch( 'cust_main',
 392            { 'agentnum' => $self->agentnum },
 393            '',
 394            " AND $sql"
 395   );
 396 }
 397
 398 =item num_active_cust_main
 399
 400 Returns the number of active customers for this agent (customers with active
 401 recurring packages).
 402
 403 =cut
 404
 405 sub num_active_cust_main {
 406   shift->num_sql(FS::cust_main->active_sql);
 407 }
 408
 409 =item active_cust_main
 410
 411 Returns the active customers for this agent, as cust_main objects.
 412
 413 =cut
 414
 415 sub active_cust_main {
 416   shift->cust_main_sql(FS::cust_main->active_sql);
 417 }
 418
 419 =item num_inactive_cust_main
 420
 421 Returns the number of inactive customers for this agent (customers with no
 422 active recurring packages, but otherwise unsuspended/uncancelled).
 423
 424 =cut
 425
 426 sub num_inactive_cust_main {
 427   shift->num_sql(FS::cust_main->inactive_sql);
 428 }
 429
 430 =item inactive_cust_main
 431
 432 Returns the inactive customers for this agent, as cust_main objects.
 433
 434 =cut
 435
 436 sub inactive_cust_main {
 437   shift->cust_main_sql(FS::cust_main->inactive_sql);
 438 }
 439
 440
 441 =item num_susp_cust_main
 442
 443 Returns the number of suspended customers for this agent.
 444
 445 =cut
 446
 447 sub num_susp_cust_main {
 448   shift->num_sql(FS::cust_main->susp_sql);
 449 }
 450
 451 =item susp_cust_main
 452
 453 Returns the suspended customers for this agent, as cust_main objects.
 454
 455 =cut
 456
 457 sub susp_cust_main {
 458   shift->cust_main_sql(FS::cust_main->susp_sql);
 459 }
 460
 461 =item num_cancel_cust_main
 462
 463 Returns the number of cancelled customer for this agent.
 464
 465 =cut
 466
 467 sub num_cancel_cust_main {
 468   shift->num_sql(FS::cust_main->cancel_sql);
 469 }
 470
 471 =item cancel_cust_main
 472
 473 Returns the cancelled customers for this agent, as cust_main objects.
 474
 475 =cut
 476
 477 sub cancel_cust_main {
 478   shift->cust_main_sql(FS::cust_main->cancel_sql);
 479 }
 480
 481 =item num_active_cust_pkg
 482
 483 Returns the number of active customer packages for this agent.
 484
 485 =cut
 486
 487 sub num_active_cust_pkg {
 488   shift->num_pkg_sql(FS::cust_pkg->active_sql);
 489 }
 490
 491 sub num_pkg_sql {
 492   my( $self, $sql ) = @_;
 493   my $statement =
 494     "SELECT COUNT(*) FROM cust_pkg LEFT JOIN cust_main USING ( custnum )".
 495     " WHERE agentnum = ? AND $sql";
 496   my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
 497   $sth->execute($self->agentnum) or die $sth->errstr. "executing $statement";
 498   $sth->fetchrow_arrayref->[0];
 499 }
 500
 501 =item num_inactive_cust_pkg
 502
 503 Returns the number of inactive customer packages (one-time packages otherwise
 504 unsuspended/uncancelled) for this agent.
 505
 506 =cut
 507
 508 sub num_inactive_cust_pkg {
 509   shift->num_pkg_sql(FS::cust_pkg->inactive_sql);
 510 }
 511
 512 =item num_susp_cust_pkg
 513
 514 Returns the number of suspended customer packages for this agent.
 515
 516 =cut
 517
 518 sub num_susp_cust_pkg {
 519   shift->num_pkg_sql(FS::cust_pkg->susp_sql);
 520 }
 521
 522 =item num_cancel_cust_pkg
 523
 524 Returns the number of cancelled customer packages for this agent.
 525
 526 =cut
 527
 528 sub num_cancel_cust_pkg {
 529   shift->num_pkg_sql(FS::cust_pkg->cancel_sql);
 530 }
 531
 532 =item generate_reg_codes NUM PKGPART_ARRAYREF
 533
 534 Generates the specified number of registration codes, allowing purchase of the
 535 specified package definitions.  Returns an array reference of the newly
 536 generated codes, or a scalar error message.
 537
 538 =cut
 539
 540 #false laziness w/prepay_credit::generate
 541 sub generate_reg_codes {
 542   my( $self, $num, $pkgparts ) = @_;
 543
 544   my @codeset = ( 'A'..'Z' );
 545
 546   local $SIG{HUP} = 'IGNORE';
 547   local $SIG{INT} = 'IGNORE';
 548   local $SIG{QUIT} = 'IGNORE';
 549   local $SIG{TERM} = 'IGNORE';
 550   local $SIG{TSTP} = 'IGNORE';
 551   local $SIG{PIPE} = 'IGNORE';
 552
 553   my $oldAutoCommit = $FS::UID::AutoCommit;
 554   local $FS::UID::AutoCommit = 0;
 555   my $dbh = dbh;
 556
 557   my @codes = ();
 558   for ( 1 ... $num ) {
 559     my $reg_code = new FS::reg_code {
 560       'agentnum' => $self->agentnum,
 561       'code'     => join('', map($codeset[int(rand $#codeset)], (0..7) ) ),
 562     };
 563     my $error = $reg_code->insert($pkgparts);
 564     if ( $error ) {
 565       $dbh->rollback if $oldAutoCommit;
 566       return $error;
 567     }
 568     push @codes, $reg_code->code;
 569   }
 570
 571   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 572
 573   \@codes;
 574
 575 }
 576
 577 =item num_reg_code
 578
 579 Returns the number of unused registration codes for this agent.
 580
 581 =cut
 582
 583 sub num_reg_code {
 584   my $self = shift;
 585   my $sth = dbh->prepare(
 586     "SELECT COUNT(*) FROM reg_code WHERE agentnum = ?"
 587   ) or die dbh->errstr;
 588   $sth->execute($self->agentnum) or die $sth->errstr;
 589   $sth->fetchrow_arrayref->[0];
 590 }
 591
 592 =item num_prepay_credit
 593
 594 Returns the number of unused prepaid cards for this agent.
 595
 596 =cut
 597
 598 sub num_prepay_credit {
 599   my $self = shift;
 600   my $sth = dbh->prepare(
 601     "SELECT COUNT(*) FROM prepay_credit WHERE agentnum = ?"
 602   ) or die dbh->errstr;
 603   $sth->execute($self->agentnum) or die $sth->errstr;
 604   $sth->fetchrow_arrayref->[0];
 605 }
 606
 607
 608 =back
 609
 610 =head1 BUGS
 611
 612 =head1 SEE ALSO
 613
 614 L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, L<FS::part_pkg>,
 615 schema.html from the base documentation.
 616
 617 =cut
 618
 619 1;
 620