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>,
 234 I<payinfo>, and I<thirdparty>.
 235
 236 If I<nofatal> is set, and no gateway is available, then the empty string
 237 will be returned instead of throwing a fatal exception.
 238
 239 If I<invnum> is set to the number of an invoice (see L<FS::cust_bill>) then
 240 an attempt will be made to select a gateway suited for the taxes paid on
 241 the invoice.
 242
 243 The I<method> and I<payinfo> options can be used to influence the choice
 244 as well.  Presently only 'CC', 'ECHECK', and 'PAYPAL' methods are meaningful.
 245
 246 When the I<method> is 'CC' then the card number in I<payinfo> can direct
 247 this routine to route to a gateway suited for that type of card.
 248
 249 If I<thirdparty> is set, the defined self-service payment gateway will
 250 be returned.
 251
 252 =cut
 253
 254 sub payment_gateway {
 255   my ( $self, %options ) = @_;
 256
 257   my $conf = new FS::Conf;
 258
 259   if ( $options{thirdparty} ) {
 260     # still a kludge, but it gets the job done
 261     # and the 'cardtype' semantics don't really apply to thirdparty
 262     # gateways because we have to choose a gateway without ever
 263     # seeing the card number
 264     my $gatewaynum =
 265       $conf->config('selfservice-payment_gateway', $self->agentnum);
 266     my $gateway = FS::payment_gateway->by_key($gatewaynum)
 267       if $gatewaynum;
 268
 269     if ( $gateway ) {
 270       return $gateway;
 271     } elsif ( $options{'nofatal'} ) {
 272       return '';
 273     } else {
 274       die "no third-party gateway configured\n";
 275     }
 276   }
 277
 278   my $taxclass = '';
 279   if ( $options{invnum} ) {
 280
 281     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{invnum} } );
 282     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
 283
 284     my @part_pkg =
 285       map  { $_->part_pkg }
 286       grep { $_ }
 287       map  { $_->cust_pkg }
 288       $cust_bill->cust_bill_pkg;
 289
 290     my @taxclasses = map $_->taxclass, @part_pkg;
 291
 292     $taxclass = $taxclasses[0]
 293       unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
 294                                                         #different taxclasses
 295   }
 296
 297   #look for an agent gateway override first
 298   my $cardtype = '';
 299   if ( $options{method} ) {
 300     if ( $options{method} eq 'CC' && $options{payinfo} ) {
 301       $cardtype = cardtype($options{payinfo});
 302     } elsif ( $options{method} eq 'ECHECK' ) {
 303       $cardtype = 'ACH';
 304     } else {
 305       $cardtype = $options{method}
 306     }
 307   }
 308
 309   my $override =
 310        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 311                                            cardtype => $cardtype,
 312                                            taxclass => $taxclass,       } )
 313     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 314                                            cardtype => '',
 315                                            taxclass => $taxclass,       } )
 316     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 317                                            cardtype => $cardtype,
 318                                            taxclass => '',              } )
 319     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
 320                                            cardtype => '',
 321                                            taxclass => '',              } );
 322
 323   my $payment_gateway;
 324   if ( $override ) { #use a payment gateway override
 325
 326     $payment_gateway = $override->payment_gateway;
 327
 328     $payment_gateway->gateway_namespace('Business::OnlinePayment')
 329       unless $payment_gateway->gateway_namespace;
 330
 331   } else { #use the standard settings from the config
 332
 333     # the standard settings from the config could be moved to a null agent
 334     # agent_payment_gateway referenced payment_gateway
 335
 336     unless ( $conf->exists('business-onlinepayment') ) {
 337       if ( $options{'nofatal'} ) {
 338         return '';
 339       } else {
 340         die "Real-time processing not enabled\n";
 341       }
 342     }
 343
 344     #load up config
 345     my $bop_config = 'business-onlinepayment';
 346     $bop_config .= '-ach'
 347       if ( $options{method}
 348            && $options{method} =~ /^(ECHECK|CHEK)$/
 349            && $conf->exists($bop_config. '-ach')
 350          );
 351     my ( $processor, $login, $password, $action, @bop_options ) =
 352       $conf->config($bop_config);
 353     $action ||= 'normal authorization';
 354     pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
 355     die "No real-time processor is enabled - ".
 356         "did you set the business-onlinepayment configuration value?\n"
 357       unless $processor;
 358
 359     $payment_gateway = new FS::payment_gateway;
 360
 361     $payment_gateway->gateway_namespace( $conf->config('business-onlinepayment-namespace') ||
 362                                  'Business::OnlinePayment');
 363     $payment_gateway->gateway_module($processor);
 364     $payment_gateway->gateway_username($login);
 365     $payment_gateway->gateway_password($password);
 366     $payment_gateway->gateway_action($action);
 367     $payment_gateway->set('options', [ @bop_options ]);
 368
 369   }
 370
 371   unless ( $payment_gateway->gateway_namespace ) {
 372     $payment_gateway->gateway_namespace(
 373       scalar($conf->config('business-onlinepayment-namespace'))
 374       || 'Business::OnlinePayment'
 375     );
 376   }
 377
 378   $payment_gateway;
 379 }
 380
 381 =item num_prospect_cust_main
 382
 383 Returns the number of prospects (customers with no packages ever ordered) for
 384 this agent.
 385
 386 =cut
 387
 388 sub num_prospect_cust_main {
 389   shift->num_sql(FS::cust_main->prospect_sql);
 390 }
 391
 392 sub num_sql {
 393   my( $self, $sql ) = @_;
 394   my $statement = "SELECT COUNT(*) FROM cust_main WHERE agentnum = ? AND $sql";
 395   my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
 396   $sth->execute($self->agentnum) or die $sth->errstr. " executing $statement";
 397   $sth->fetchrow_arrayref->[0];
 398 }
 399
 400 =item prospect_cust_main
 401
 402 Returns the prospects (customers with no packages ever ordered) for this agent,
 403 as cust_main objects.
 404
 405 =cut
 406
 407 sub prospect_cust_main {
 408   shift->cust_main_sql(FS::cust_main->prospect_sql);
 409 }
 410
 411 sub cust_main_sql {
 412   my( $self, $sql ) = @_;
 413   qsearch( 'cust_main',
 414            { 'agentnum' => $self->agentnum },
 415            '',
 416            " AND $sql"
 417   );
 418 }
 419
 420 =item num_active_cust_main
 421
 422 Returns the number of active customers for this agent (customers with active
 423 recurring packages).
 424
 425 =cut
 426
 427 sub num_active_cust_main {
 428   shift->num_sql(FS::cust_main->active_sql);
 429 }
 430
 431 =item active_cust_main
 432
 433 Returns the active customers for this agent, as cust_main objects.
 434
 435 =cut
 436
 437 sub active_cust_main {
 438   shift->cust_main_sql(FS::cust_main->active_sql);
 439 }
 440
 441 =item num_inactive_cust_main
 442
 443 Returns the number of inactive customers for this agent (customers with no
 444 active recurring packages, but otherwise unsuspended/uncancelled).
 445
 446 =cut
 447
 448 sub num_inactive_cust_main {
 449   shift->num_sql(FS::cust_main->inactive_sql);
 450 }
 451
 452 =item inactive_cust_main
 453
 454 Returns the inactive customers for this agent, as cust_main objects.
 455
 456 =cut
 457
 458 sub inactive_cust_main {
 459   shift->cust_main_sql(FS::cust_main->inactive_sql);
 460 }
 461
 462
 463 =item num_susp_cust_main
 464
 465 Returns the number of suspended customers for this agent.
 466
 467 =cut
 468
 469 sub num_susp_cust_main {
 470   shift->num_sql(FS::cust_main->susp_sql);
 471 }
 472
 473 =item susp_cust_main
 474
 475 Returns the suspended customers for this agent, as cust_main objects.
 476
 477 =cut
 478
 479 sub susp_cust_main {
 480   shift->cust_main_sql(FS::cust_main->susp_sql);
 481 }
 482
 483 =item num_cancel_cust_main
 484
 485 Returns the number of cancelled customer for this agent.
 486
 487 =cut
 488
 489 sub num_cancel_cust_main {
 490   shift->num_sql(FS::cust_main->cancel_sql);
 491 }
 492
 493 =item cancel_cust_main
 494
 495 Returns the cancelled customers for this agent, as cust_main objects.
 496
 497 =cut
 498
 499 sub cancel_cust_main {
 500   shift->cust_main_sql(FS::cust_main->cancel_sql);
 501 }
 502
 503 =item num_active_cust_pkg
 504
 505 Returns the number of active customer packages for this agent.
 506
 507 =cut
 508
 509 sub num_active_cust_pkg {
 510   shift->num_pkg_sql(FS::cust_pkg->active_sql);
 511 }
 512
 513 sub num_pkg_sql {
 514   my( $self, $sql ) = @_;
 515   my $statement =
 516     "SELECT COUNT(*) FROM cust_pkg LEFT JOIN cust_main USING ( custnum )".
 517     " WHERE agentnum = ? AND $sql";
 518   my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
 519   $sth->execute($self->agentnum) or die $sth->errstr. "executing $statement";
 520   $sth->fetchrow_arrayref->[0];
 521 }
 522
 523 =item num_inactive_cust_pkg
 524
 525 Returns the number of inactive customer packages (one-time packages otherwise
 526 unsuspended/uncancelled) for this agent.
 527
 528 =cut
 529
 530 sub num_inactive_cust_pkg {
 531   shift->num_pkg_sql(FS::cust_pkg->inactive_sql);
 532 }
 533
 534 =item num_susp_cust_pkg
 535
 536 Returns the number of suspended customer packages for this agent.
 537
 538 =cut
 539
 540 sub num_susp_cust_pkg {
 541   shift->num_pkg_sql(FS::cust_pkg->susp_sql);
 542 }
 543
 544 =item num_cancel_cust_pkg
 545
 546 Returns the number of cancelled customer packages for this agent.
 547
 548 =cut
 549
 550 sub num_cancel_cust_pkg {
 551   shift->num_pkg_sql(FS::cust_pkg->cancel_sql);
 552 }
 553
 554 =item generate_reg_codes NUM PKGPART_ARRAYREF
 555
 556 Generates the specified number of registration codes, allowing purchase of the
 557 specified package definitions.  Returns an array reference of the newly
 558 generated codes, or a scalar error message.
 559
 560 =cut
 561
 562 #false laziness w/prepay_credit::generate
 563 sub generate_reg_codes {
 564   my( $self, $num, $pkgparts ) = @_;
 565
 566   my @codeset = ( 'A'..'Z' );
 567
 568   local $SIG{HUP} = 'IGNORE';
 569   local $SIG{INT} = 'IGNORE';
 570   local $SIG{QUIT} = 'IGNORE';
 571   local $SIG{TERM} = 'IGNORE';
 572   local $SIG{TSTP} = 'IGNORE';
 573   local $SIG{PIPE} = 'IGNORE';
 574
 575   my $oldAutoCommit = $FS::UID::AutoCommit;
 576   local $FS::UID::AutoCommit = 0;
 577   my $dbh = dbh;
 578
 579   my @codes = ();
 580   for ( 1 ... $num ) {
 581     my $reg_code = new FS::reg_code {
 582       'agentnum' => $self->agentnum,
 583       'code'     => join('', map($codeset[int(rand $#codeset)], (0..7) ) ),
 584     };
 585     my $error = $reg_code->insert($pkgparts);
 586     if ( $error ) {
 587       $dbh->rollback if $oldAutoCommit;
 588       return $error;
 589     }
 590     push @codes, $reg_code->code;
 591   }
 592
 593   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 594
 595   \@codes;
 596
 597 }
 598
 599 =item num_reg_code
 600
 601 Returns the number of unused registration codes for this agent.
 602
 603 =cut
 604
 605 sub num_reg_code {
 606   my $self = shift;
 607   my $sth = dbh->prepare(
 608     "SELECT COUNT(*) FROM reg_code WHERE agentnum = ?"
 609   ) or die dbh->errstr;
 610   $sth->execute($self->agentnum) or die $sth->errstr;
 611   $sth->fetchrow_arrayref->[0];
 612 }
 613
 614 =item num_prepay_credit
 615
 616 Returns the number of unused prepaid cards for this agent.
 617
 618 =cut
 619
 620 sub num_prepay_credit {
 621   my $self = shift;
 622   my $sth = dbh->prepare(
 623     "SELECT COUNT(*) FROM prepay_credit WHERE agentnum = ?"
 624   ) or die dbh->errstr;
 625   $sth->execute($self->agentnum) or die $sth->errstr;
 626   $sth->fetchrow_arrayref->[0];
 627 }
 628
 629
 630 =back
 631
 632 =head1 BUGS
 633
 634 =head1 SEE ALSO
 635
 636 L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, L<FS::part_pkg>,
 637 schema.html from the base documentation.
 638
 639 =cut
 640
 641 1;
 642