FS/FS/cust_pkg.pm

   1 package FS::cust_pkg;
   2
   3 use strict;
   4 use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
   5 use Tie::IxHash;
   6 use FS::UID qw( getotaker dbh );
   7 use FS::Misc qw( send_email );
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::cust_main_Mixin;
  10 use FS::cust_svc;
  11 use FS::part_pkg;
  12 use FS::cust_main;
  13 use FS::type_pkgs;
  14 use FS::pkg_svc;
  15 use FS::cust_bill_pkg;
  16 use FS::h_cust_svc;
  17 use FS::reg_code;
  18
  19 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
  20 # setup }
  21 # because they load configuration by setting FS::UID::callback (see TODO)
  22 use FS::svc_acct;
  23 use FS::svc_domain;
  24 use FS::svc_www;
  25 use FS::svc_forward;
  26
  27 # for sending cancel emails in sub cancel
  28 use FS::Conf;
  29
  30 @ISA = qw( FS::cust_main_Mixin FS::Record );
  31
  32 $DEBUG = 0;
  33
  34 $disable_agentcheck = 0;
  35
  36 # The order in which to unprovision services.
  37 @SVCDB_CANCEL_SEQ = qw( svc_external
  38                         svc_www
  39                         svc_forward
  40                         svc_acct
  41                         svc_domain
  42                         svc_broadband );
  43
  44 sub _cache {
  45   my $self = shift;
  46   my ( $hashref, $cache ) = @_;
  47   #if ( $hashref->{'pkgpart'} ) {
  48   if ( $hashref->{'pkg'} ) {
  49     # #@{ $self->{'_pkgnum'} } = ();
  50     # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
  51     # $self->{'_pkgpart'} = $subcache;
  52     # #push @{ $self->{'_pkgnum'} },
  53     #   FS::part_pkg->new_or_cached($hashref, $subcache);
  54     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
  55   }
  56   if ( exists $hashref->{'svcnum'} ) {
  57     #@{ $self->{'_pkgnum'} } = ();
  58     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
  59     $self->{'_svcnum'} = $subcache;
  60     #push @{ $self->{'_pkgnum'} },
  61     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
  62   }
  63 }
  64
  65 =head1 NAME
  66
  67 FS::cust_pkg - Object methods for cust_pkg objects
  68
  69 =head1 SYNOPSIS
  70
  71   use FS::cust_pkg;
  72
  73   $record = new FS::cust_pkg \%hash;
  74   $record = new FS::cust_pkg { 'column' => 'value' };
  75
  76   $error = $record->insert;
  77
  78   $error = $new_record->replace($old_record);
  79
  80   $error = $record->delete;
  81
  82   $error = $record->check;
  83
  84   $error = $record->cancel;
  85
  86   $error = $record->suspend;
  87
  88   $error = $record->unsuspend;
  89
  90   $part_pkg = $record->part_pkg;
  91
  92   @labels = $record->labels;
  93
  94   $seconds = $record->seconds_since($timestamp);
  95
  96   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
  97   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
  98
  99 =head1 DESCRIPTION
 100
 101 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
 102 inherits from FS::Record.  The following fields are currently supported:
 103
 104 =over 4
 105
 106 =item pkgnum - primary key (assigned automatically for new billing items)
 107
 108 =item custnum - Customer (see L<FS::cust_main>)
 109
 110 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
 111
 112 =item setup - date
 113
 114 =item bill - date (next bill date)
 115
 116 =item last_bill - last bill date
 117
 118 =item susp - date
 119
 120 =item expire - date
 121
 122 =item cancel - date
 123
 124 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
 125
 126 =item manual_flag - If this field is set to 1, disables the automatic
 127 unsuspension of this package when using the B<unsuspendauto> config file.
 128
 129 =back
 130
 131 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
 132 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
 133 conversion functions.
 134
 135 =head1 METHODS
 136
 137 =over 4
 138
 139 =item new HASHREF
 140
 141 Create a new billing item.  To add the item to the database, see L<"insert">.
 142
 143 =cut
 144
 145 sub table { 'cust_pkg'; }
 146 sub cust_linked { $_[0]->cust_main_custnum; }
 147 sub cust_unlinked_msg {
 148   my $self = shift;
 149   "WARNING: can't find cust_main.custnum ". $self->custnum.
 150   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 151 }
 152
 153 =item insert [ OPTION => VALUE ... ]
 154
 155 Adds this billing item to the database ("Orders" the item).  If there is an
 156 error, returns the error, otherwise returns false.
 157
 158 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 159 will be used to look up the package definition and agent restrictions will be
 160 ignored.
 161
 162 The following options are available: I<change>
 163
 164 I<change>, if set true, supresses any referral credit to a referring customer.
 165
 166 =cut
 167
 168 sub insert {
 169   my( $self, %options ) = @_;
 170
 171   local $SIG{HUP} = 'IGNORE';
 172   local $SIG{INT} = 'IGNORE';
 173   local $SIG{QUIT} = 'IGNORE';
 174   local $SIG{TERM} = 'IGNORE';
 175   local $SIG{TSTP} = 'IGNORE';
 176   local $SIG{PIPE} = 'IGNORE';
 177
 178   my $oldAutoCommit = $FS::UID::AutoCommit;
 179   local $FS::UID::AutoCommit = 0;
 180   my $dbh = dbh;
 181
 182   my $error = $self->SUPER::insert;
 183   if ( $error ) {
 184     $dbh->rollback if $oldAutoCommit;
 185     return $error;
 186   }
 187
 188   #if ( $self->reg_code ) {
 189   #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
 190   #  $error = $reg_code->delete;
 191   #  if ( $error ) {
 192   #    $dbh->rollback if $oldAutoCommit;
 193   #    return $error;
 194   #  }
 195   #}
 196
 197   my $conf = new FS::Conf;
 198   my $cust_main = $self->cust_main;
 199   my $part_pkg = $self->part_pkg;
 200   if ( $conf->exists('referral_credit')
 201        && $cust_main->referral_custnum
 202        && ! $options{'change'}
 203        && $part_pkg->freq !~ /^0\D?$/
 204      )
 205   {
 206     my $referring_cust_main = $cust_main->referring_cust_main;
 207     if ( $referring_cust_main->status ne 'cancelled' ) {
 208       my $error;
 209       if ( $part_pkg->freq !~ /^\d+$/ ) {
 210         warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
 211              ' for package '. $self->pkgnum.
 212              ' ( customer '. $self->custnum. ')'.
 213              ' - One-time referral credits not (yet) available for '.
 214              ' packages with '. $part_pkg->freq_pretty. ' frequency';
 215       } else {
 216
 217         my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
 218         my $error =
 219           $referring_cust_main->credit( $amount,
 220                                         'Referral credit for '. $cust_main->name
 221                                       );
 222         if ( $error ) {
 223           $dbh->rollback if $oldAutoCommit;
 224           return "Error crediting customer ". $cust_main->referral_custnum.
 225                " for referral: $error";
 226         }
 227
 228       }
 229
 230     }
 231   }
 232
 233   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 234   '';
 235
 236 }
 237
 238 =item delete
 239
 240 This method now works but you probably shouldn't use it.
 241
 242 You don't want to delete billing items, because there would then be no record
 243 the customer ever purchased the item.  Instead, see the cancel method.
 244
 245 =cut
 246
 247 #sub delete {
 248 #  return "Can't delete cust_pkg records!";
 249 #}
 250
 251 =item replace OLD_RECORD
 252
 253 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 254 returns the error, otherwise returns false.
 255
 256 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
 257
 258 Changing pkgpart may have disasterous effects.  See the order subroutine.
 259
 260 setup and bill are normally updated by calling the bill method of a customer
 261 object (see L<FS::cust_main>).
 262
 263 suspend is normally updated by the suspend and unsuspend methods.
 264
 265 cancel is normally updated by the cancel method (and also the order subroutine
 266 in some cases).
 267
 268 Calls
 269
 270 =cut
 271
 272 sub replace {
 273   my( $new, $old ) = ( shift, shift );
 274
 275   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
 276   return "Can't change otaker!" if $old->otaker ne $new->otaker;
 277
 278   #allow this *sigh*
 279   #return "Can't change setup once it exists!"
 280   #  if $old->getfield('setup') &&
 281   #     $old->getfield('setup') != $new->getfield('setup');
 282
 283   #some logic for bill, susp, cancel?
 284
 285   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
 286
 287   local $SIG{HUP} = 'IGNORE';
 288   local $SIG{INT} = 'IGNORE';
 289   local $SIG{QUIT} = 'IGNORE';
 290   local $SIG{TERM} = 'IGNORE';
 291   local $SIG{TSTP} = 'IGNORE';
 292   local $SIG{PIPE} = 'IGNORE';
 293
 294   my $oldAutoCommit = $FS::UID::AutoCommit;
 295   local $FS::UID::AutoCommit = 0;
 296   my $dbh = dbh;
 297
 298   #save off and freeze RADIUS attributes for any associated svc_acct records
 299   my @svc_acct = ();
 300   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
 301
 302                 #also check for specific exports?
 303                 # to avoid spurious modify export events
 304     @svc_acct = map  { $_->svc_x }
 305                 grep { $_->part_svc->svcdb eq 'svc_acct' }
 306                      $old->cust_svc;
 307
 308     $_->snapshot foreach @svc_acct;
 309
 310   }
 311
 312   my $error = $new->SUPER::replace($old);
 313   if ( $error ) {
 314     $dbh->rollback if $oldAutoCommit;
 315     return $error;
 316   }
 317
 318   #for prepaid packages,
 319   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
 320   foreach my $old_svc_acct ( @svc_acct ) {
 321     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
 322     my $s_error = $new_svc_acct->replace($old_svc_acct);
 323     if ( $s_error ) {
 324       $dbh->rollback if $oldAutoCommit;
 325       return $s_error;
 326     }
 327   }
 328
 329   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 330   '';
 331
 332 }
 333
 334 =item check
 335
 336 Checks all fields to make sure this is a valid billing item.  If there is an
 337 error, returns the error, otherwise returns false.  Called by the insert and
 338 replace methods.
 339
 340 =cut
 341
 342 sub check {
 343   my $self = shift;
 344
 345   my $error =
 346     $self->ut_numbern('pkgnum')
 347     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
 348     || $self->ut_numbern('pkgpart')
 349     || $self->ut_numbern('setup')
 350     || $self->ut_numbern('bill')
 351     || $self->ut_numbern('susp')
 352     || $self->ut_numbern('cancel')
 353   ;
 354   return $error if $error;
 355
 356   if ( $self->reg_code ) {
 357
 358     unless ( grep { $self->pkgpart == $_->pkgpart }
 359              map  { $_->reg_code_pkg }
 360              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
 361                                      'agentnum' => $self->cust_main->agentnum })
 362            ) {
 363       return "Unknown registration code";
 364     }
 365
 366   } elsif ( $self->promo_code ) {
 367
 368     my $promo_part_pkg =
 369       qsearchs('part_pkg', {
 370         'pkgpart'    => $self->pkgpart,
 371         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
 372       } );
 373     return 'Unknown promotional code' unless $promo_part_pkg;
 374
 375   } else {
 376
 377     unless ( $disable_agentcheck ) {
 378       my $agent =
 379         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
 380       my $pkgpart_href = $agent->pkgpart_hashref;
 381       return "agent ". $agent->agentnum.
 382              " can't purchase pkgpart ". $self->pkgpart
 383         unless $pkgpart_href->{ $self->pkgpart };
 384     }
 385
 386     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
 387     return $error if $error;
 388
 389   }
 390
 391   $self->otaker(getotaker) unless $self->otaker;
 392   $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
 393   $self->otaker($1);
 394
 395   if ( $self->dbdef_table->column('manual_flag') ) {
 396     $self->manual_flag('') if $self->manual_flag eq ' ';
 397     $self->manual_flag =~ /^([01]?)$/
 398       or return "Illegal manual_flag ". $self->manual_flag;
 399     $self->manual_flag($1);
 400   }
 401
 402   $self->SUPER::check;
 403 }
 404
 405 =item cancel [ OPTION => VALUE ... ]
 406
 407 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 408 in this package, then cancels the package itself (sets the cancel field to
 409 now).
 410
 411 Available options are: I<quiet>
 412
 413 I<quiet> can be set true to supress email cancellation notices.
 414
 415 If there is an error, returns the error, otherwise returns false.
 416
 417 =cut
 418
 419 sub cancel {
 420   my( $self, %options ) = @_;
 421   my $error;
 422
 423   local $SIG{HUP} = 'IGNORE';
 424   local $SIG{INT} = 'IGNORE';
 425   local $SIG{QUIT} = 'IGNORE';
 426   local $SIG{TERM} = 'IGNORE';
 427   local $SIG{TSTP} = 'IGNORE';
 428   local $SIG{PIPE} = 'IGNORE';
 429
 430   my $oldAutoCommit = $FS::UID::AutoCommit;
 431   local $FS::UID::AutoCommit = 0;
 432   my $dbh = dbh;
 433
 434   my %svc;
 435   foreach my $cust_svc (
 436       qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 437   ) {
 438     push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
 439   }
 440
 441   foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
 442     foreach my $cust_svc (@{ $svc{$svcdb} }) {
 443       my $error = $cust_svc->cancel;
 444
 445       if ( $error ) {
 446         $dbh->rollback if $oldAutoCommit;
 447         return "Error cancelling cust_svc: $error";
 448       }
 449     }
 450   }
 451
 452   # Add a credit for remaining service
 453   my $remaining_value = $self->calc_remain();
 454   if ( $remaining_value > 0 ) {
 455     my $error = $self->cust_main->credit(
 456       $remaining_value,
 457       'Credit for unused time on '. $self->part_pkg->pkg,
 458     );
 459     if ($error) {
 460       $dbh->rollback if $oldAutoCommit;
 461       return "Error crediting customer \$$remaining_value for unused time on".
 462              $self->part_pkg->pkg. ": $error";
 463     }
 464   }
 465
 466   unless ( $self->getfield('cancel') ) {
 467     my %hash = $self->hash;
 468     $hash{'cancel'} = time;
 469     my $new = new FS::cust_pkg ( \%hash );
 470     $error = $new->replace($self);
 471     if ( $error ) {
 472       $dbh->rollback if $oldAutoCommit;
 473       return $error;
 474     }
 475   }
 476
 477   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 478
 479   my $conf = new FS::Conf;
 480   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
 481   if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
 482     my $conf = new FS::Conf;
 483     my $error = send_email(
 484       'from'    => $conf->config('invoice_from'),
 485       'to'      => \@invoicing_list,
 486       'subject' => $conf->config('cancelsubject'),
 487       'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
 488     );
 489     #should this do something on errors?
 490   }
 491
 492   ''; #no errors
 493
 494 }
 495
 496 =item suspend
 497
 498 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 499 package, then suspends the package itself (sets the susp field to now).
 500
 501 If there is an error, returns the error, otherwise returns false.
 502
 503 =cut
 504
 505 sub suspend {
 506   my $self = shift;
 507   my $error ;
 508
 509   local $SIG{HUP} = 'IGNORE';
 510   local $SIG{INT} = 'IGNORE';
 511   local $SIG{QUIT} = 'IGNORE';
 512   local $SIG{TERM} = 'IGNORE';
 513   local $SIG{TSTP} = 'IGNORE';
 514   local $SIG{PIPE} = 'IGNORE';
 515
 516   my $oldAutoCommit = $FS::UID::AutoCommit;
 517   local $FS::UID::AutoCommit = 0;
 518   my $dbh = dbh;
 519
 520   foreach my $cust_svc (
 521     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
 522   ) {
 523     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 524
 525     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 526       $dbh->rollback if $oldAutoCommit;
 527       return "Illegal svcdb value in part_svc!";
 528     };
 529     my $svcdb = $1;
 530     require "FS/$svcdb.pm";
 531
 532     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 533     if ($svc) {
 534       $error = $svc->suspend;
 535       if ( $error ) {
 536         $dbh->rollback if $oldAutoCommit;
 537         return $error;
 538       }
 539     }
 540
 541   }
 542
 543   unless ( $self->getfield('susp') ) {
 544     my %hash = $self->hash;
 545     $hash{'susp'} = time;
 546     my $new = new FS::cust_pkg ( \%hash );
 547     $error = $new->replace($self);
 548     if ( $error ) {
 549       $dbh->rollback if $oldAutoCommit;
 550       return $error;
 551     }
 552   }
 553
 554   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 555
 556   ''; #no errors
 557 }
 558
 559 =item unsuspend
 560
 561 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 562 package, then unsuspends the package itself (clears the susp field).
 563
 564 If there is an error, returns the error, otherwise returns false.
 565
 566 =cut
 567
 568 sub unsuspend {
 569   my $self = shift;
 570   my($error);
 571
 572   local $SIG{HUP} = 'IGNORE';
 573   local $SIG{INT} = 'IGNORE';
 574   local $SIG{QUIT} = 'IGNORE';
 575   local $SIG{TERM} = 'IGNORE';
 576   local $SIG{TSTP} = 'IGNORE';
 577   local $SIG{PIPE} = 'IGNORE';
 578
 579   my $oldAutoCommit = $FS::UID::AutoCommit;
 580   local $FS::UID::AutoCommit = 0;
 581   my $dbh = dbh;
 582
 583   foreach my $cust_svc (
 584     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 585   ) {
 586     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 587
 588     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 589       $dbh->rollback if $oldAutoCommit;
 590       return "Illegal svcdb value in part_svc!";
 591     };
 592     my $svcdb = $1;
 593     require "FS/$svcdb.pm";
 594
 595     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
 596     if ($svc) {
 597       $error = $svc->unsuspend;
 598       if ( $error ) {
 599         $dbh->rollback if $oldAutoCommit;
 600         return $error;
 601       }
 602     }
 603
 604   }
 605
 606   unless ( ! $self->getfield('susp') ) {
 607     my %hash = $self->hash;
 608     my $inactive = time - $hash{'susp'};
 609     $hash{'susp'} = '';
 610     $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
 611       if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
 612     my $new = new FS::cust_pkg ( \%hash );
 613     $error = $new->replace($self);
 614     if ( $error ) {
 615       $dbh->rollback if $oldAutoCommit;
 616       return $error;
 617     }
 618   }
 619
 620   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 621
 622   ''; #no errors
 623 }
 624
 625 =item last_bill
 626
 627 Returns the last bill date, or if there is no last bill date, the setup date.
 628 Useful for billing metered services.
 629
 630 =cut
 631
 632 sub last_bill {
 633   my $self = shift;
 634   if ( $self->dbdef_table->column('last_bill') ) {
 635     return $self->setfield('last_bill', $_[0]) if @_;
 636     return $self->getfield('last_bill') if $self->getfield('last_bill');
 637   }
 638   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
 639                                                   'edate'  => $self->bill,  } );
 640   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
 641 }
 642
 643 =item part_pkg
 644
 645 Returns the definition for this billing item, as an FS::part_pkg object (see
 646 L<FS::part_pkg>).
 647
 648 =cut
 649
 650 sub part_pkg {
 651   my $self = shift;
 652   #exists( $self->{'_pkgpart'} )
 653   $self->{'_pkgpart'}
 654     ? $self->{'_pkgpart'}
 655     : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 656 }
 657
 658 =item calc_setup
 659
 660 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
 661 item.
 662
 663 =cut
 664
 665 sub calc_setup {
 666   my $self = shift;
 667   $self->part_pkg->calc_setup($self, @_);
 668 }
 669
 670 =item calc_recur
 671
 672 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
 673 item.
 674
 675 =cut
 676
 677 sub calc_recur {
 678   my $self = shift;
 679   $self->part_pkg->calc_recur($self, @_);
 680 }
 681
 682 =item calc_remain
 683
 684 Calls the I<calc_remain> of the FS::part_pkg object associated with this
 685 billing item.
 686
 687 =cut
 688
 689 sub calc_remain {
 690   my $self = shift;
 691   $self->part_pkg->calc_remain($self, @_);
 692 }
 693
 694 =item calc_cancel
 695
 696 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
 697 billing item.
 698
 699 =cut
 700
 701 sub calc_cancel {
 702   my $self = shift;
 703   $self->part_pkg->calc_cancel($self, @_);
 704 }
 705
 706 =item cust_svc [ SVCPART ]
 707
 708 Returns the services for this package, as FS::cust_svc objects (see
 709 L<FS::cust_svc>).  If a svcpart is specified, return only the matching
 710 services.
 711
 712 =cut
 713
 714 sub cust_svc {
 715   my $self = shift;
 716
 717   if ( @_ ) {
 718     return qsearch( 'cust_svc', { 'pkgnum'  => $self->pkgnum,
 719                                   'svcpart' => shift,          } );
 720   }
 721
 722   #if ( $self->{'_svcnum'} ) {
 723   #  values %{ $self->{'_svcnum'}->cache };
 724   #} else {
 725     $self->_sort_cust_svc(
 726       [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
 727     );
 728   #}
 729
 730 }
 731
 732 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
 733
 734 Returns historical services for this package created before END TIMESTAMP and
 735 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
 736 (see L<FS::h_cust_svc>).
 737
 738 =cut
 739
 740 sub h_cust_svc {
 741   my $self = shift;
 742
 743   $self->_sort_cust_svc(
 744     [ qsearch( 'h_cust_svc',
 745                { 'pkgnum' => $self->pkgnum, },
 746                FS::h_cust_svc->sql_h_search(@_),
 747              )
 748     ]
 749   );
 750 }
 751
 752 sub _sort_cust_svc {
 753   my( $self, $arrayref ) = @_;
 754
 755   map  { $_->[0] }
 756   sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
 757   map {
 758         my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
 759                                              'svcpart' => $_->svcpart     } );
 760         [ $_,
 761           $pkg_svc ? $pkg_svc->primary_svc : '',
 762           $pkg_svc ? $pkg_svc->quantity : 0,
 763         ];
 764       }
 765   @$arrayref;
 766
 767 }
 768
 769 =item num_cust_svc [ SVCPART ]
 770
 771 Returns the number of provisioned services for this package.  If a svcpart is
 772 specified, counts only the matching services.
 773
 774 =cut
 775
 776 sub num_cust_svc {
 777   my $self = shift;
 778   my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
 779   $sql .= ' AND svcpart = ?' if @_;
 780   my $sth = dbh->prepare($sql) or die dbh->errstr;
 781   $sth->execute($self->pkgnum, @_) or die $sth->errstr;
 782   $sth->fetchrow_arrayref->[0];
 783 }
 784
 785 =item available_part_svc
 786
 787 Returns a list FS::part_svc objects representing services included in this
 788 package but not yet provisioned.  Each FS::part_svc object also has an extra
 789 field, I<num_avail>, which specifies the number of available services.
 790
 791 =cut
 792
 793 sub available_part_svc {
 794   my $self = shift;
 795   grep { $_->num_avail > 0 }
 796     map {
 797           my $part_svc = $_->part_svc;
 798           $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
 799             $_->quantity - $self->num_cust_svc($_->svcpart);
 800           $part_svc;
 801         }
 802       $self->part_pkg->pkg_svc;
 803 }
 804
 805 =item status
 806
 807 Returns a short status string for this package, currently:
 808
 809 =over 4
 810
 811 =item not yet billed
 812
 813 =item one-time charge
 814
 815 =item active
 816
 817 =item suspended
 818
 819 =item cancelled
 820
 821 =back
 822
 823 =cut
 824
 825 sub status {
 826   my $self = shift;
 827
 828   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
 829
 830   return 'cancelled' if $self->get('cancel');
 831   return 'suspended' if $self->susp;
 832   return 'not yet billed' unless $self->setup;
 833   return 'one-time charge' if $freq =~ /^(0|$)/;
 834   return 'active';
 835 }
 836
 837 =item statuses
 838
 839 Class method that returns the list of possible status strings for pacakges
 840 (see L<the status method|/status>).  For example:
 841
 842   @statuses = FS::cust_pkg->statuses();
 843
 844 =cut
 845
 846 tie my %statuscolor, 'Tie::IxHash',
 847   'not yet billed'  => '000000',
 848   'one-time charge' => '000000',
 849   'active'          => '00CC00',
 850   'suspended'       => 'FF9900',
 851   'cancelled'       => 'FF0000',
 852 ;
 853
 854 sub statuses {
 855   my $self = shift; #could be class...
 856   grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
 857                                       # mayble split btw one-time vs. recur
 858     keys %statuscolor;
 859 }
 860
 861 =item statuscolor
 862
 863 Returns a hex triplet color string for this package's status.
 864
 865 =cut
 866
 867 sub statuscolor {
 868   my $self = shift;
 869   $statuscolor{$self->status};
 870 }
 871
 872 =item labels
 873
 874 Returns a list of lists, calling the label method for all services
 875 (see L<FS::cust_svc>) of this billing item.
 876
 877 =cut
 878
 879 sub labels {
 880   my $self = shift;
 881   map { [ $_->label ] } $self->cust_svc;
 882 }
 883
 884 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
 885
 886 Like the labels method, but returns historical information on services that
 887 were active as of END_TIMESTAMP and (optionally) not cancelled before
 888 START_TIMESTAMP.
 889
 890 Returns a list of lists, calling the label method for all (historical) services
 891 (see L<FS::h_cust_svc>) of this billing item.
 892
 893 =cut
 894
 895 sub h_labels {
 896   my $self = shift;
 897   map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
 898 }
 899
 900 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
 901
 902 Like h_labels, except returns a simple flat list, and shortens long
 903 (currently >5) lists of identical services to one line that lists the service
 904 label and the number of individual services rather than individual items.
 905
 906 =cut
 907
 908 sub h_labels_short {
 909   my $self = shift;
 910
 911   my %labels;
 912   #tie %labels, 'Tie::IxHash';
 913   push @{ $labels{$_->[0]} }, $_->[1]
 914     foreach $self->h_labels(@_);
 915   my @labels;
 916   foreach my $label ( keys %labels ) {
 917     my @values = @{ $labels{$label} };
 918     my $num = scalar(@values);
 919     if ( $num > 5 ) {
 920       push @labels, "$label ($num)";
 921     } else {
 922       push @labels, map { "$label: $_" } @values;
 923     }
 924   }
 925
 926  @labels;
 927
 928 }
 929
 930 =item cust_main
 931
 932 Returns the parent customer object (see L<FS::cust_main>).
 933
 934 =cut
 935
 936 sub cust_main {
 937   my $self = shift;
 938   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 939 }
 940
 941 =item seconds_since TIMESTAMP
 942
 943 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
 944 package have been online since TIMESTAMP, according to the session monitor.
 945
 946 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 947 L<Time::Local> and L<Date::Parse> for conversion functions.
 948
 949 =cut
 950
 951 sub seconds_since {
 952   my($self, $since) = @_;
 953   my $seconds = 0;
 954
 955   foreach my $cust_svc (
 956     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
 957   ) {
 958     $seconds += $cust_svc->seconds_since($since);
 959   }
 960
 961   $seconds;
 962
 963 }
 964
 965 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 966
 967 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
 968 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
 969 (exclusive).
 970
 971 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 972 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 973 functions.
 974
 975
 976 =cut
 977
 978 sub seconds_since_sqlradacct {
 979   my($self, $start, $end) = @_;
 980
 981   my $seconds = 0;
 982
 983   foreach my $cust_svc (
 984     grep {
 985       my $part_svc = $_->part_svc;
 986       $part_svc->svcdb eq 'svc_acct'
 987         && scalar($part_svc->part_export('sqlradius'));
 988     } $self->cust_svc
 989   ) {
 990     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
 991   }
 992
 993   $seconds;
 994
 995 }
 996
 997 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 998
 999 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1000 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1001 TIMESTAMP_END
1002 (exclusive).
1003
1004 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1005 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1006 functions.
1007
1008 =cut
1009
1010 sub attribute_since_sqlradacct {
1011   my($self, $start, $end, $attrib) = @_;
1012
1013   my $sum = 0;
1014
1015   foreach my $cust_svc (
1016     grep {
1017       my $part_svc = $_->part_svc;
1018       $part_svc->svcdb eq 'svc_acct'
1019         && scalar($part_svc->part_export('sqlradius'));
1020     } $self->cust_svc
1021   ) {
1022     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1023   }
1024
1025   $sum;
1026
1027 }
1028
1029 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1030
1031 Transfers as many services as possible from this package to another package.
1032
1033 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1034 object.  The destination package must already exist.
1035
1036 Services are moved only if the destination allows services with the correct
1037 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
1038 this option with caution!  No provision is made for export differences
1039 between the old and new service definitions.  Probably only should be used
1040 when your exports for all service definitions of a given svcdb are identical.
1041 (attempt a transfer without it first, to move all possible svcpart-matching
1042 services)
1043
1044 Any services that can't be moved remain in the original package.
1045
1046 Returns an error, if there is one; otherwise, returns the number of services
1047 that couldn't be moved.
1048
1049 =cut
1050
1051 sub transfer {
1052   my ($self, $dest_pkgnum, %opt) = @_;
1053
1054   my $remaining = 0;
1055   my $dest;
1056   my %target;
1057
1058   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1059     $dest = $dest_pkgnum;
1060     $dest_pkgnum = $dest->pkgnum;
1061   } else {
1062     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1063   }
1064
1065   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1066
1067   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1068     $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1069   }
1070
1071   foreach my $cust_svc ($dest->cust_svc) {
1072     $target{$cust_svc->svcpart}--;
1073   }
1074
1075   my %svcpart2svcparts = ();
1076   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1077     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1078     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1079       next if exists $svcpart2svcparts{$svcpart};
1080       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1081       $svcpart2svcparts{$svcpart} = [
1082         map  { $_->[0] }
1083         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] }
1084         map {
1085               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1086                                                    'svcpart' => $_          } );
1087               [ $_,
1088                 $pkg_svc ? $pkg_svc->primary_svc : '',
1089                 $pkg_svc ? $pkg_svc->quantity : 0,
1090               ];
1091             }
1092
1093         grep { $_ != $svcpart }
1094         map  { $_->svcpart }
1095         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1096       ];
1097       warn "alternates for svcpart $svcpart: ".
1098            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1099         if $DEBUG;
1100     }
1101   }
1102
1103   foreach my $cust_svc ($self->cust_svc) {
1104     if($target{$cust_svc->svcpart} > 0) {
1105       $target{$cust_svc->svcpart}--;
1106       my $new = new FS::cust_svc {
1107         svcnum  => $cust_svc->svcnum,
1108         svcpart => $cust_svc->svcpart,
1109         pkgnum  => $dest_pkgnum,
1110       };
1111       my $error = $new->replace($cust_svc);
1112       return $error if $error;
1113     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1114       if ( $DEBUG ) {
1115         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1116         warn "alternates to consider: ".
1117              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1118       }
1119       my @alternate = grep {
1120                              warn "considering alternate svcpart $_: ".
1121                                   "$target{$_} available in new package\n"
1122                                if $DEBUG;
1123                              $target{$_} > 0;
1124                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
1125       if ( @alternate ) {
1126         warn "alternate(s) found\n" if $DEBUG;
1127         my $change_svcpart = $alternate[0];
1128         $target{$change_svcpart}--;
1129         my $new = new FS::cust_svc {
1130           svcnum  => $cust_svc->svcnum,
1131           svcpart => $change_svcpart,
1132           pkgnum  => $dest_pkgnum,
1133         };
1134         my $error = $new->replace($cust_svc);
1135         return $error if $error;
1136       } else {
1137         $remaining++;
1138       }
1139     } else {
1140       $remaining++
1141     }
1142   }
1143   return $remaining;
1144 }
1145
1146 =item reexport
1147
1148 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1149 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1150
1151 =cut
1152
1153 sub reexport {
1154   my $self = shift;
1155
1156   local $SIG{HUP} = 'IGNORE';
1157   local $SIG{INT} = 'IGNORE';
1158   local $SIG{QUIT} = 'IGNORE';
1159   local $SIG{TERM} = 'IGNORE';
1160   local $SIG{TSTP} = 'IGNORE';
1161   local $SIG{PIPE} = 'IGNORE';
1162
1163   my $oldAutoCommit = $FS::UID::AutoCommit;
1164   local $FS::UID::AutoCommit = 0;
1165   my $dbh = dbh;
1166
1167   foreach my $cust_svc ( $self->cust_svc ) {
1168     #false laziness w/svc_Common::insert
1169     my $svc_x = $cust_svc->svc_x;
1170     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1171       my $error = $part_export->export_insert($svc_x);
1172       if ( $error ) {
1173         $dbh->rollback if $oldAutoCommit;
1174         return $error;
1175       }
1176     }
1177   }
1178
1179   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1180   '';
1181
1182 }
1183
1184 =back
1185
1186 =head1 CLASS METHODS
1187
1188 =over 4
1189
1190 =item recurring_sql
1191
1192 Returns an SQL expression identifying recurring packages.
1193
1194 =cut
1195
1196 sub recurring_sql { "
1197   '0' != ( select freq from part_pkg
1198              where cust_pkg.pkgpart = part_pkg.pkgpart )
1199 "; }
1200
1201 =item onetime_sql
1202
1203 Returns an SQL expression identifying one-time packages.
1204
1205 =cut
1206
1207 sub onetime_sql { "
1208   '0' = ( select freq from part_pkg
1209             where cust_pkg.pkgpart = part_pkg.pkgpart )
1210 "; }
1211
1212 =item active_sql
1213
1214 Returns an SQL expression identifying active packages.
1215
1216 =cut
1217
1218 sub active_sql { "
1219   ". $_[0]->recurring_sql(). "
1220   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1221   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
1222 "; }
1223
1224 =item inactive_sql
1225
1226 Returns an SQL expression identifying inactive packages (one-time packages
1227 that are otherwise unsuspended/uncancelled).
1228
1229 =cut
1230
1231 sub inactive_sql { "
1232   ". $_[0]->onetime_sql(). "
1233   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1234   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
1235 "; }
1236
1237 =item susp_sql
1238 =item suspended_sql
1239
1240 Returns an SQL expression identifying suspended packages.
1241
1242 =cut
1243
1244 sub suspended_sql { susp_sql(@_); }
1245 sub susp_sql {
1246   #$_[0]->recurring_sql(). ' AND '.
1247   "
1248         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
1249     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
1250   ";
1251 }
1252
1253 =item cancel_sql
1254 =item cancelled_sql
1255
1256 Returns an SQL exprression identifying cancelled packages.
1257
1258 =cut
1259
1260 sub cancelled_sql { cancel_sql(@_); }
1261 sub cancel_sql {
1262   #$_[0]->recurring_sql(). ' AND '.
1263   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1264 }
1265
1266 =head1 SUBROUTINES
1267
1268 =over 4
1269
1270 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
1271
1272 CUSTNUM is a customer (see L<FS::cust_main>)
1273
1274 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
1275 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
1276 permitted.
1277
1278 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
1279 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
1280 new billing items.  An error is returned if this is not possible (see
1281 L<FS::pkg_svc>).  An empty arrayref is equivalent to not specifying this
1282 parameter.
1283
1284 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
1285 newly-created cust_pkg objects.
1286
1287 =cut
1288
1289 sub order {
1290   my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
1291
1292   my $conf = new FS::Conf;
1293
1294   # Transactionize this whole mess
1295   local $SIG{HUP} = 'IGNORE';
1296   local $SIG{INT} = 'IGNORE';
1297   local $SIG{QUIT} = 'IGNORE';
1298   local $SIG{TERM} = 'IGNORE';
1299   local $SIG{TSTP} = 'IGNORE';
1300   local $SIG{PIPE} = 'IGNORE';
1301
1302   my $oldAutoCommit = $FS::UID::AutoCommit;
1303   local $FS::UID::AutoCommit = 0;
1304   my $dbh = dbh;
1305
1306   my $error;
1307   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
1308   return "Customer not found: $custnum" unless $cust_main;
1309
1310   my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
1311                          @$remove_pkgnum;
1312
1313   my $change = scalar(@old_cust_pkg) != 0;
1314
1315   my %hash = ();
1316   if ( scalar(@old_cust_pkg) == 1 ) {
1317     #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
1318     $hash{'setup'} = time;
1319   }
1320
1321   # Create the new packages.
1322   foreach my $pkgpart (@$pkgparts) {
1323     my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
1324                                       pkgpart => $pkgpart,
1325                                       %hash,
1326                                     };
1327     $error = $cust_pkg->insert( 'change' => $change );
1328     if ($error) {
1329       $dbh->rollback if $oldAutoCommit;
1330       return $error;
1331     }
1332     push @$return_cust_pkg, $cust_pkg;
1333   }
1334   # $return_cust_pkg now contains refs to all of the newly
1335   # created packages.
1336
1337   # Transfer services and cancel old packages.
1338   foreach my $old_pkg (@old_cust_pkg) {
1339
1340     foreach my $new_pkg (@$return_cust_pkg) {
1341       $error = $old_pkg->transfer($new_pkg);
1342       if ($error and $error == 0) {
1343         # $old_pkg->transfer failed.
1344         $dbh->rollback if $oldAutoCommit;
1345         return $error;
1346       }
1347     }
1348
1349     if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1350       warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1351       foreach my $new_pkg (@$return_cust_pkg) {
1352         $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
1353         if ($error and $error == 0) {
1354           # $old_pkg->transfer failed.
1355         $dbh->rollback if $oldAutoCommit;
1356         return $error;
1357         }
1358       }
1359     }
1360
1361     if ($error > 0) {
1362       # Transfers were successful, but we went through all of the
1363       # new packages and still had services left on the old package.
1364       # We can't cancel the package under the circumstances, so abort.
1365       $dbh->rollback if $oldAutoCommit;
1366       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
1367     }
1368     $error = $old_pkg->cancel( quiet=>1 );
1369     if ($error) {
1370       $dbh->rollback;
1371       return $error;
1372     }
1373   }
1374   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1375   '';
1376 }
1377
1378 =back
1379
1380 =head1 BUGS
1381
1382 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
1383
1384 In sub order, the @pkgparts array (passed by reference) is clobbered.
1385
1386 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
1387 method to pass dates to the recur_prog expression, it should do so.
1388
1389 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
1390 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
1391 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
1392 configuration values.  Probably need a subroutine which decides what to do
1393 based on whether or not we've fetched the user yet, rather than a hash.  See
1394 FS::UID and the TODO.
1395
1396 Now that things are transactional should the check in the insert method be
1397 moved to check ?
1398
1399 =head1 SEE ALSO
1400
1401 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
1402 L<FS::pkg_svc>, schema.html from the base documentation
1403
1404 =cut
1405
1406 1;
1407