FS/FS/part_pkg.pm

   1 package FS::part_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA %plans $DEBUG $setup_hack );
   5 use Carp qw(carp cluck confess);
   6 use Scalar::Util qw( blessed );
   7 use Time::Local qw( timelocal_nocheck );
   8 use Tie::IxHash;
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs dbh dbdef );
  11 use FS::pkg_svc;
  12 use FS::part_svc;
  13 use FS::cust_pkg;
  14 use FS::agent_type;
  15 use FS::type_pkgs;
  16 use FS::part_pkg_option;
  17 use FS::pkg_class;
  18 use FS::agent;
  19 use FS::part_pkg_taxoverride;
  20 use FS::part_pkg_taxproduct;
  21 use FS::part_pkg_link;
  22
  23 @ISA = qw( FS::m2m_Common FS::option_Common );
  24 $DEBUG = 0;
  25 $setup_hack = 0;
  26
  27 =head1 NAME
  28
  29 FS::part_pkg - Object methods for part_pkg objects
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::part_pkg;
  34
  35   $record = new FS::part_pkg \%hash
  36   $record = new FS::part_pkg { 'column' => 'value' };
  37
  38   $custom_record = $template_record->clone;
  39
  40   $error = $record->insert;
  41
  42   $error = $new_record->replace($old_record);
  43
  44   $error = $record->delete;
  45
  46   $error = $record->check;
  47
  48   @pkg_svc = $record->pkg_svc;
  49
  50   $svcnum = $record->svcpart;
  51   $svcnum = $record->svcpart( 'svc_acct' );
  52
  53 =head1 DESCRIPTION
  54
  55 An FS::part_pkg object represents a package definition.  FS::part_pkg
  56 inherits from FS::Record.  The following fields are currently supported:
  57
  58 =over 4
  59
  60 =item pkgpart - primary key (assigned automatically for new package definitions)
  61
  62 =item pkg - Text name of this package definition (customer-viewable)
  63
  64 =item comment - Text name of this package definition (non-customer-viewable)
  65
  66 =item classnum - Optional package class (see L<FS::pkg_class>)
  67
  68 =item promo_code - Promotional code
  69
  70 =item setup - Setup fee expression (deprecated)
  71
  72 =item freq - Frequency of recurring fee
  73
  74 =item recur - Recurring fee expression (deprecated)
  75
  76 =item setuptax - Setup fee tax exempt flag, empty or `Y'
  77
  78 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
  79
  80 =item taxclass - Tax class
  81
  82 =item plan - Price plan
  83
  84 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
  85
  86 =item disabled - Disabled flag, empty or `Y'
  87
  88 =item setup_cost - for cost tracking
  89
  90 =item recur_cost - for cost tracking
  91
  92 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
  93
  94 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
  95
  96 =item agentnum - Optional agentnum (see L<FS::agent>)
  97
  98 =back
  99
 100 =head1 METHODS
 101
 102 =over 4
 103
 104 =item new HASHREF
 105
 106 Creates a new package definition.  To add the package definition to
 107 the database, see L<"insert">.
 108
 109 =cut
 110
 111 sub table { 'part_pkg'; }
 112
 113 =item clone
 114
 115 An alternate constructor.  Creates a new package definition by duplicating
 116 an existing definition.  A new pkgpart is assigned and `(CUSTOM) ' is prepended
 117 to the comment field.  To add the package definition to the database, see
 118 L<"insert">.
 119
 120 =cut
 121
 122 sub clone {
 123   my $self = shift;
 124   my $class = ref($self);
 125   my %hash = $self->hash;
 126   $hash{'pkgpart'} = '';
 127   $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
 128     unless $hash{'comment'} =~ /^\(CUSTOM\) /;
 129   #new FS::part_pkg ( \%hash ); # ?
 130   new $class ( \%hash ); # ?
 131 }
 132
 133 =item insert [ , OPTION => VALUE ... ]
 134
 135 Adds this package definition to the database.  If there is an error,
 136 returns the error, otherwise returns false.
 137
 138 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
 139 I<custnum_ref> and I<options>.
 140
 141 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 142 values, appropriate FS::pkg_svc records will be inserted.
 143
 144 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 145 FS::pkg_svc record will be updated.
 146
 147 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
 148 record itself), the object will be updated to point to this package definition.
 149
 150 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
 151 the scalar will be updated with the custnum value from the cust_pkg record.
 152
 153 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
 154 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
 155 records will be inserted.
 156
 157 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
 158 records will be inserted.
 159
 160 =cut
 161
 162 sub insert {
 163   my $self = shift;
 164   my %options = @_;
 165   warn "FS::part_pkg::insert called on $self with options ".
 166        join(', ', map "$_=>$options{$_}", keys %options)
 167     if $DEBUG;
 168
 169   local $SIG{HUP} = 'IGNORE';
 170   local $SIG{INT} = 'IGNORE';
 171   local $SIG{QUIT} = 'IGNORE';
 172   local $SIG{TERM} = 'IGNORE';
 173   local $SIG{TSTP} = 'IGNORE';
 174   local $SIG{PIPE} = 'IGNORE';
 175
 176   my $oldAutoCommit = $FS::UID::AutoCommit;
 177   local $FS::UID::AutoCommit = 0;
 178   my $dbh = dbh;
 179
 180   warn "  inserting part_pkg record" if $DEBUG;
 181   my $error = $self->SUPER::insert( $options{options} );
 182   if ( $error ) {
 183     $dbh->rollback if $oldAutoCommit;
 184     return $error;
 185   }
 186
 187   my $conf = new FS::Conf;
 188   if ( $conf->exists('agent_defaultpkg') ) {
 189     warn "  agent_defaultpkg set; allowing all agents to purchase package"
 190       if $DEBUG;
 191     foreach my $agent_type ( qsearch('agent_type', {} ) ) {
 192       my $type_pkgs = new FS::type_pkgs({
 193         'typenum' => $agent_type->typenum,
 194         'pkgpart' => $self->pkgpart,
 195       });
 196       my $error = $type_pkgs->insert;
 197       if ( $error ) {
 198         $dbh->rollback if $oldAutoCommit;
 199         return $error;
 200       }
 201     }
 202   }
 203
 204   warn "  inserting part_pkg_taxoverride records" if $DEBUG;
 205   my %overrides = %{ $options{'tax_overrides'} || {} };
 206   foreach my $usage_class ( keys %overrides ) {
 207     my @overrides = (grep "$_", split (',', $overrides{$usage_class}) );
 208     my $error = $self->process_m2m (
 209                   'link_table'   => 'part_pkg_taxoverride',
 210                   'target_table' => 'tax_class',
 211                   'hashref'      => { 'usage_class' => $usage_class },
 212                   'params'       => \@overrides,
 213                 );
 214     if ( $error ) {
 215       $dbh->rollback if $oldAutoCommit;
 216       return $error;
 217     }
 218   }
 219
 220   warn "  inserting pkg_svc records" if $DEBUG;
 221   my $pkg_svc = $options{'pkg_svc'} || {};
 222   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 223     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 224     my $primary_svc =
 225       ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
 226         ? 'Y'
 227         : '';
 228
 229     my $pkg_svc = new FS::pkg_svc( {
 230       'pkgpart'     => $self->pkgpart,
 231       'svcpart'     => $part_svc->svcpart,
 232       'quantity'    => $quantity,
 233       'primary_svc' => $primary_svc,
 234     } );
 235     my $error = $pkg_svc->insert;
 236     if ( $error ) {
 237       $dbh->rollback if $oldAutoCommit;
 238       return $error;
 239     }
 240   }
 241
 242   if ( $options{'cust_pkg'} ) {
 243     warn "  updating cust_pkg record " if $DEBUG;
 244     my $old_cust_pkg =
 245       ref($options{'cust_pkg'})
 246         ? $options{'cust_pkg'}
 247         : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
 248     ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
 249       if $options{'custnum_ref'};
 250     my %hash = $old_cust_pkg->hash;
 251     $hash{'pkgpart'} = $self->pkgpart,
 252     my $new_cust_pkg = new FS::cust_pkg \%hash;
 253     local($FS::cust_pkg::disable_agentcheck) = 1;
 254     my $error = $new_cust_pkg->replace($old_cust_pkg);
 255     if ( $error ) {
 256       $dbh->rollback if $oldAutoCommit;
 257       return "Error modifying cust_pkg record: $error";
 258     }
 259   }
 260
 261   warn "  commiting transaction" if $DEBUG;
 262   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 263
 264   '';
 265 }
 266
 267 =item delete
 268
 269 Currently unimplemented.
 270
 271 =cut
 272
 273 sub delete {
 274   return "Can't (yet?) delete package definitions.";
 275 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 276 }
 277
 278 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
 279
 280 Replaces OLD_RECORD with this one in the database.  If there is an error,
 281 returns the error, otherwise returns false.
 282
 283 Currently available options are: I<pkg_svc>, I<primary_svc> and I<options>
 284
 285 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 286 values, the appropriate FS::pkg_svc records will be replaced.
 287
 288 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 289 FS::pkg_svc record will be updated.
 290
 291 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
 292 will be replaced.
 293
 294 =cut
 295
 296 sub replace {
 297   my $new = shift;
 298
 299   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 300               ? shift
 301               : $new->replace_old;
 302
 303   my $options =
 304     ( ref($_[0]) eq 'HASH' )
 305       ? shift
 306       : { @_ };
 307
 308   $options->{options} = {} unless defined($options->{options});
 309
 310   warn "FS::part_pkg::replace called on $new to replace $old with options".
 311        join(', ', map "$_ => ". $options->{$_}, keys %$options)
 312     if $DEBUG;
 313
 314   local $SIG{HUP} = 'IGNORE';
 315   local $SIG{INT} = 'IGNORE';
 316   local $SIG{QUIT} = 'IGNORE';
 317   local $SIG{TERM} = 'IGNORE';
 318   local $SIG{TSTP} = 'IGNORE';
 319   local $SIG{PIPE} = 'IGNORE';
 320
 321   my $oldAutoCommit = $FS::UID::AutoCommit;
 322   local $FS::UID::AutoCommit = 0;
 323   my $dbh = dbh;
 324
 325   #plandata shit stays in replace for upgrades until after 2.0 (or edit
 326   #_upgrade_data)
 327   warn "  saving legacy plandata" if $DEBUG;
 328   my $plandata = $new->get('plandata');
 329   $new->set('plandata', '');
 330
 331   warn "  deleting old part_pkg_option records" if $DEBUG;
 332   foreach my $part_pkg_option ( $old->part_pkg_option ) {
 333     my $error = $part_pkg_option->delete;
 334     if ( $error ) {
 335       $dbh->rollback if $oldAutoCommit;
 336       return $error;
 337     }
 338   }
 339
 340   warn "  replacing part_pkg record" if $DEBUG;
 341   my $error = $new->SUPER::replace($old, $options->{options} );
 342   if ( $error ) {
 343     $dbh->rollback if $oldAutoCommit;
 344     return $error;
 345   }
 346
 347   warn "  inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
 348   foreach my $part_pkg_option (
 349     map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
 350                                  return "illegal plandata: $plandata";
 351                                };
 352           new FS::part_pkg_option {
 353             'pkgpart'     => $new->pkgpart,
 354             'optionname'  => $1,
 355             'optionvalue' => $2,
 356           };
 357         }
 358     split("\n", $plandata)
 359   ) {
 360     my $error = $part_pkg_option->insert;
 361     if ( $error ) {
 362       $dbh->rollback if $oldAutoCommit;
 363       return $error;
 364     }
 365   }
 366
 367   warn "  replacing pkg_svc records" if $DEBUG;
 368   my $pkg_svc = $options->{'pkg_svc'} || {};
 369   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 370     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 371     my $primary_svc =
 372       ( defined($options->{'primary_svc'})
 373         && $options->{'primary_svc'} == $part_svc->svcpart
 374       )
 375         ? 'Y'
 376         : '';
 377
 378
 379     my $old_pkg_svc = qsearchs('pkg_svc', {
 380       'pkgpart' => $old->pkgpart,
 381       'svcpart' => $part_svc->svcpart,
 382     } );
 383     my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
 384     my $old_primary_svc =
 385       ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
 386         ? $old_pkg_svc->primary_svc
 387         : '';
 388     next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
 389
 390     my $new_pkg_svc = new FS::pkg_svc( {
 391       'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
 392       'pkgpart'     => $new->pkgpart,
 393       'svcpart'     => $part_svc->svcpart,
 394       'quantity'    => $quantity,
 395       'primary_svc' => $primary_svc,
 396     } );
 397     my $error = $old_pkg_svc
 398                   ? $new_pkg_svc->replace($old_pkg_svc)
 399                   : $new_pkg_svc->insert;
 400     if ( $error ) {
 401       $dbh->rollback if $oldAutoCommit;
 402       return $error;
 403     }
 404   }
 405
 406   warn "  commiting transaction" if $DEBUG;
 407   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 408   '';
 409 }
 410
 411 =item check
 412
 413 Checks all fields to make sure this is a valid package definition.  If
 414 there is an error, returns the error, otherwise returns false.  Called by the
 415 insert and replace methods.
 416
 417 =cut
 418
 419 sub check {
 420   my $self = shift;
 421   warn "FS::part_pkg::check called on $self" if $DEBUG;
 422
 423   for (qw(setup recur plandata)) {
 424     #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 425     return "Use of $_ field is deprecated; set a plan and options: ".
 426            $self->get($_)
 427       if length($self->get($_));
 428     $self->set($_, '');
 429   }
 430
 431   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 432     my $error = $self->ut_number('freq');
 433     return $error if $error;
 434   } else {
 435     $self->freq =~ /^(\d+[hdw]?)$/
 436       or return "Illegal or empty freq: ". $self->freq;
 437     $self->freq($1);
 438   }
 439
 440   my @null_agentnum_right = ( 'Edit global package definitions' );
 441   push @null_agentnum_right, 'One-time charge'
 442     if $self->freq =~ /^0/;
 443   push @null_agentnum_right, 'Customize customer package'
 444     if $self->disabled eq 'Y'; #good enough
 445
 446   my $error = $self->ut_numbern('pkgpart')
 447     || $self->ut_text('pkg')
 448     || $self->ut_text('comment')
 449     || $self->ut_textn('promo_code')
 450     || $self->ut_alphan('plan')
 451     || $self->ut_enum('setuptax', [ '', 'Y' ] )
 452     || $self->ut_enum('recurtax', [ '', 'Y' ] )
 453     || $self->ut_textn('taxclass')
 454     || $self->ut_enum('disabled', [ '', 'Y' ] )
 455     #|| $self->ut_moneyn('setup_cost')
 456     #|| $self->ut_moneyn('recur_cost')
 457     || $self->ut_floatn('setup_cost')
 458     || $self->ut_floatn('recur_cost')
 459     || $self->ut_floatn('pay_weight')
 460     || $self->ut_floatn('credit_weight')
 461     || $self->ut_numbern('taxproductnum')
 462     || $self->ut_foreign_keyn('taxproductnum',
 463                               'part_pkg_taxproduct',
 464                               'taxproductnum'
 465                              )
 466     || ( $setup_hack
 467            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
 468            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
 469        )
 470     || $self->SUPER::check
 471   ;
 472   return $error if $error;
 473
 474   if ( $self->classnum !~ /^$/ ) {
 475     my $error = $self->ut_foreign_key('classnum', 'pkg_class', 'classnum');
 476     return $error if $error;
 477   } else {
 478     $self->classnum('');
 479   }
 480
 481   return 'Unknown plan '. $self->plan
 482     unless exists($plans{$self->plan});
 483
 484   my $conf = new FS::Conf;
 485   return 'Taxclass is required'
 486     if ! $self->taxclass && $conf->exists('require_taxclasses');
 487
 488   '';
 489 }
 490
 491 =item pkg_comment
 492
 493 Returns an (internal) string representing this package.  Currently,
 494 "pkgpart: pkg - comment", is returned.  "pkg - comment" may be returned in the
 495 future, omitting pkgpart.
 496
 497 =cut
 498
 499 sub pkg_comment {
 500   my $self = shift;
 501
 502   #$self->pkg. ' - '. $self->comment;
 503   #$self->pkg. ' ('. $self->comment. ')';
 504   $self->pkgpart. ': '. $self->pkg. ' - '. $self->comment;
 505 }
 506
 507 =item pkg_class
 508
 509 Returns the package class, as an FS::pkg_class object, or the empty string
 510 if there is no package class.
 511
 512 =cut
 513
 514 sub pkg_class {
 515   my $self = shift;
 516   if ( $self->classnum ) {
 517     qsearchs('pkg_class', { 'classnum' => $self->classnum } );
 518   } else {
 519     return '';
 520   }
 521 }
 522
 523 =item categoryname
 524
 525 Returns the package category name, or the empty string if there is no package
 526 category.
 527
 528 =cut
 529
 530 sub categoryname {
 531   my $self = shift;
 532   my $pkg_class = $self->pkg_class;
 533   $pkg_class
 534     ? $pkg_class->categoryname
 535     : '';
 536 }
 537
 538 =item classname
 539
 540 Returns the package class name, or the empty string if there is no package
 541 class.
 542
 543 =cut
 544
 545 sub classname {
 546   my $self = shift;
 547   my $pkg_class = $self->pkg_class;
 548   $pkg_class
 549     ? $pkg_class->classname
 550     : '';
 551 }
 552
 553 =item agent
 554
 555 Returns the associated agent for this event, if any, as an FS::agent object.
 556
 557 =cut
 558
 559 sub agent {
 560   my $self = shift;
 561   qsearchs('agent', { 'agentnum' => $self->agentnum } );
 562 }
 563
 564 =item pkg_svc [ HASHREF | OPTION => VALUE ]
 565
 566 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 567 definition (with non-zero quantity).
 568
 569 One option is available, I<disable_linked>.  If set true it will return the
 570 services for this package definition alone, omitting services from any add-on
 571 packages.
 572
 573 =cut
 574
 575 =item type_pkgs
 576
 577 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
 578 definition.
 579
 580 =cut
 581
 582 sub type_pkgs {
 583   my $self = shift;
 584   qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
 585 }
 586
 587 sub pkg_svc {
 588   my $self = shift;
 589
 590 #  #sort { $b->primary cmp $a->primary }
 591 #    grep { $_->quantity }
 592 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 593
 594   my $opt = ref($_[0]) ? $_[0] : { @_ };
 595   my %pkg_svc = map  { $_->svcpart => $_ }
 596                 grep { $_->quantity }
 597                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 598
 599   unless ( $opt->{disable_linked} ) {
 600     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
 601       my @pkg_svc = grep { $_->quantity }
 602                     qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
 603       foreach my $pkg_svc ( @pkg_svc ) {
 604         if ( $pkg_svc{$pkg_svc->svcpart} ) {
 605           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
 606           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
 607         } else {
 608           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
 609         }
 610       }
 611     }
 612   }
 613
 614   values(%pkg_svc);
 615
 616 }
 617
 618 =item svcpart [ SVCDB ]
 619
 620 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
 621 associated with this package definition (see L<FS::pkg_svc>).  Returns
 622 false if there not a primary service definition or exactly one service
 623 definition with quantity 1, or if SVCDB is specified and does not match the
 624 svcdb of the service definition.  SVCDB can be specified as a scalar table
 625 name, such as 'svc_acct', or as an arrayref of possible table names.
 626
 627 =cut
 628
 629 sub svcpart {
 630   my $pkg_svc = shift->_primary_pkg_svc(@_);
 631   $pkg_svc ? $pkg_svc->svcpart : '';
 632 }
 633
 634 =item part_svc [ SVCDB ]
 635
 636 Like the B<svcpart> method, but returns the FS::part_svc object (see
 637 L<FS::part_svc>).
 638
 639 =cut
 640
 641 sub part_svc {
 642   my $pkg_svc = shift->_primary_pkg_svc(@_);
 643   $pkg_svc ? $pkg_svc->part_svc : '';
 644 }
 645
 646 sub _primary_pkg_svc {
 647   my $self = shift;
 648
 649   my $svcdb = scalar(@_) ? shift : [];
 650   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
 651   my %svcdb = map { $_=>1 } @$svcdb;
 652
 653   my @svcdb_pkg_svc =
 654     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
 655          $self->pkg_svc;
 656
 657   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
 658   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
 659     unless @pkg_svc;
 660   return '' if scalar(@pkg_svc) != 1;
 661   $pkg_svc[0];
 662 }
 663
 664 =item svcpart_unique_svcdb SVCDB
 665
 666 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
 667 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
 668 false if there not a primary service definition for SVCDB or there are multiple
 669 service definitions for SVCDB.
 670
 671 =cut
 672
 673 sub svcpart_unique_svcdb {
 674   my( $self, $svcdb ) = @_;
 675   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
 676   return '' if scalar(@svcdb_pkg_svc) != 1;
 677   $svcdb_pkg_svc[0]->svcpart;
 678 }
 679
 680 =item payby
 681
 682 Returns a list of the acceptable payment types for this package.  Eventually
 683 this should come out of a database table and be editable, but currently has the
 684 following logic instead:
 685
 686 If the package is free, the single item B<BILL> is
 687 returned, otherwise, the single item B<CARD> is returned.
 688
 689 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 690
 691 =cut
 692
 693 sub payby {
 694   my $self = shift;
 695   if ( $self->is_free ) {
 696     ( 'BILL' );
 697   } else {
 698     ( 'CARD' );
 699   }
 700 }
 701
 702 =item is_free
 703
 704 Returns true if this package is free.
 705
 706 =cut
 707
 708 sub is_free {
 709   my $self = shift;
 710   unless ( $self->plan ) {
 711     $self->setup =~ /^\s*0+(\.0*)?\s*$/
 712       && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
 713   } elsif ( $self->can('is_free_options') ) {
 714     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
 715          map { $self->option($_) }
 716              $self->is_free_options;
 717   } else {
 718     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
 719          "provides neither is_free_options nor is_free method; returning false";
 720     0;
 721   }
 722 }
 723
 724
 725 sub freqs_href {
 726   #method, class method or sub? #my $self = shift;
 727
 728   tie my %freq, 'Tie::IxHash',
 729     '0'    => '(no recurring fee)',
 730     '1h'   => 'hourly',
 731     '1d'   => 'daily',
 732     '2d'   => 'every two days',
 733     '3d'   => 'every three days',
 734     '1w'   => 'weekly',
 735     '2w'   => 'biweekly (every 2 weeks)',
 736     '1'    => 'monthly',
 737     '45d'  => 'every 45 days',
 738     '2'    => 'bimonthly (every 2 months)',
 739     '3'    => 'quarterly (every 3 months)',
 740     '4'    => 'every 4 months',
 741     '137d' => 'every 4 1/2 months (137 days)',
 742     '6'    => 'semiannually (every 6 months)',
 743     '12'   => 'annually',
 744     '13'   => 'every 13 months (annually +1 month)',
 745     '24'   => 'biannually (every 2 years)',
 746     '36'   => 'triannually (every 3 years)',
 747     '48'   => '(every 4 years)',
 748     '60'   => '(every 5 years)',
 749     '120'  => '(every 10 years)',
 750   ;
 751
 752   \%freq;
 753
 754 }
 755
 756 =item freq_pretty
 757
 758 Returns an english representation of the I<freq> field, such as "monthly",
 759 "weekly", "semi-annually", etc.
 760
 761 =cut
 762
 763 sub freq_pretty {
 764   my $self = shift;
 765   my $freq = $self->freq;
 766
 767   #my $freqs_href = $self->freqs_href;
 768   my $freqs_href = freqs_href();
 769
 770   if ( exists($freqs_href->{$freq}) ) {
 771     $freqs_href->{$freq};
 772   } else {
 773     my $interval = 'month';
 774     if ( $freq =~ /^(\d+)([hdw])$/ ) {
 775       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
 776       $interval = $interval{$2};
 777     }
 778     if ( $1 == 1 ) {
 779       "every $interval";
 780     } else {
 781       "every $freq ${interval}s";
 782     }
 783   }
 784 }
 785
 786 =item add_freq TIMESTAMP
 787
 788 Adds the frequency of this package to the provided timestamp and returns
 789 the resulting timestamp, or -1 if the frequency of this package could not be
 790 parsed (shouldn't happen).
 791
 792 =cut
 793
 794 sub add_freq {
 795   my( $self, $date ) = @_;
 796   my $freq = $self->freq;
 797
 798   #change this bit to use Date::Manip? CAREFUL with timezones (see
 799   # mailing list archive)
 800   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
 801
 802   if ( $self->freq =~ /^\d+$/ ) {
 803     $mon += $self->freq;
 804     until ( $mon < 12 ) { $mon -= 12; $year++; }
 805   } elsif ( $self->freq =~ /^(\d+)w$/ ) {
 806     my $weeks = $1;
 807     $mday += $weeks * 7;
 808   } elsif ( $self->freq =~ /^(\d+)d$/ ) {
 809     my $days = $1;
 810     $mday += $days;
 811   } elsif ( $self->freq =~ /^(\d+)h$/ ) {
 812     my $hours = $1;
 813     $hour += $hours;
 814   } else {
 815     return -1;
 816   }
 817
 818   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
 819 }
 820
 821 =item plandata
 822
 823 For backwards compatibility, returns the plandata field as well as all options
 824 from FS::part_pkg_option.
 825
 826 =cut
 827
 828 sub plandata {
 829   my $self = shift;
 830   carp "plandata is deprecated";
 831   if ( @_ ) {
 832     $self->SUPER::plandata(@_);
 833   } else {
 834     my $plandata = $self->get('plandata');
 835     my %options = $self->options;
 836     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
 837     $plandata;
 838   }
 839 }
 840
 841 =item part_pkg_option
 842
 843 Returns all options as FS::part_pkg_option objects (see
 844 L<FS::part_pkg_option>).
 845
 846 =cut
 847
 848 sub part_pkg_option {
 849   my $self = shift;
 850   qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
 851 }
 852
 853 =item options
 854
 855 Returns a list of option names and values suitable for assigning to a hash.
 856
 857 =cut
 858
 859 sub options {
 860   my $self = shift;
 861   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
 862 }
 863
 864 =item option OPTIONNAME
 865
 866 Returns the option value for the given name, or the empty string.
 867
 868 =cut
 869
 870 sub option {
 871   my( $self, $opt, $ornull ) = @_;
 872   my $part_pkg_option =
 873     qsearchs('part_pkg_option', {
 874       pkgpart    => $self->pkgpart,
 875       optionname => $opt,
 876   } );
 877   return $part_pkg_option->optionvalue if $part_pkg_option;
 878   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
 879                      split("\n", $self->get('plandata') );
 880   return $plandata{$opt} if exists $plandata{$opt};
 881   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
 882         "not found in options or plandata!\n"
 883     unless $ornull;
 884   '';
 885 }
 886
 887 =item bill_part_pkg_link
 888
 889 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
 890
 891 =cut
 892
 893 sub bill_part_pkg_link {
 894   shift->_part_pkg_link('bill', @_);
 895 }
 896
 897 =item svc_part_pkg_link
 898
 899 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
 900
 901 =cut
 902
 903 sub svc_part_pkg_link {
 904   shift->_part_pkg_link('svc', @_);
 905 }
 906
 907 sub _part_pkg_link {
 908   my( $self, $type ) = @_;
 909   qsearch('part_pkg_link', { 'src_pkgpart' => $self->pkgpart,
 910                              'link_type'   => $type,
 911                            }
 912          );
 913 }
 914
 915 sub self_and_bill_linked {
 916   shift->_self_and_linked('bill', @_);
 917 }
 918
 919 sub _self_and_linked {
 920   my( $self, $type ) = @_;
 921
 922   ( $self,
 923     map { $_->dst_pkg->_self_and_linked($type) }
 924         $self->_part_pkg_link($type)
 925   );
 926 }
 927
 928 =item part_pkg_taxoverride [ CLASS ]
 929
 930 Returns all associated FS::part_pkg_taxoverride objects (see
 931 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
 932 of class CLASS if defined.  Class may be one of 'setup', 'recur',
 933 the empty string (default), or a usage class number (see L<FS::usage_class>).
 934 When a class is specified, the empty string class (default) is returned
 935 if no more specific values exist.
 936
 937 =cut
 938
 939 sub part_pkg_taxoverride {
 940   my $self = shift;
 941   my $class = shift;
 942
 943   my $hashref = { 'pkgpart' => $self->pkgpart };
 944   $hashref->{'usage_class'} = $class if defined($class);
 945   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
 946
 947   unless ( scalar(@overrides) || !defined($class) || !$class ){
 948     $hashref->{'usage_class'} = '';
 949     @overrides = qsearch('part_pkg_taxoverride', $hashref );
 950   }
 951
 952   @overrides;
 953 }
 954
 955 =item has_taxproduct
 956
 957 Returns true if this package has any taxproduct associated with it.
 958
 959 =cut
 960
 961 sub has_taxproduct {
 962   my $self = shift;
 963
 964   $self->taxproductnum ||
 965   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
 966           keys %{ {$self->options} }
 967   )
 968
 969 }
 970
 971
 972 =item taxproduct [ CLASS ]
 973
 974 Returns the associated tax product for this package definition (see
 975 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
 976 the usage classnum (see L<FS::usage_class>).  Returns the default
 977 tax product for this record if the more specific CLASS value does
 978 not exist.
 979
 980 =cut
 981
 982 sub taxproduct {
 983   my $self = shift;
 984   my $class = shift;
 985
 986   my $part_pkg_taxproduct;
 987
 988   my $taxproductnum = $self->taxproductnum;
 989   if ($class) {
 990     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
 991     $taxproductnum = $class_taxproductnum
 992       if $class_taxproductnum
 993   }
 994
 995   $part_pkg_taxproduct =
 996     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
 997
 998   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
 999     $taxproductnum = $self->taxproductnum;
1000     $part_pkg_taxproduct =
1001       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1002   }
1003
1004   $part_pkg_taxproduct;
1005 }
1006
1007 =item taxproduct_description [ CLASS ]
1008
1009 Returns the description of the associated tax product for this package
1010 definition (see L<FS::part_pkg_taxproduct>).
1011
1012 =cut
1013
1014 sub taxproduct_description {
1015   my $self = shift;
1016   my $part_pkg_taxproduct = $self->taxproduct(@_);
1017   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1018 }
1019
1020 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1021
1022 Returns the package to taxrate m2m records for this package in the location
1023 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1024 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1025 (see L<FS::usage_class>).
1026
1027 =cut
1028
1029 sub _expand_cch_taxproductnum {
1030   my $self = shift;
1031   my $class = shift;
1032   my $part_pkg_taxproduct = $self->taxproduct($class);
1033
1034   my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1035                          ? ( split ':', $part_pkg_taxproduct->taxproduct )
1036                          : ()
1037                      );
1038   $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1039   my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1040                       OR taxproduct = '$a:$b:$c:'
1041                       OR taxproduct = '$a:$b:".":$d'
1042                       OR taxproduct = '$a:$b:".":' )";
1043   map { $_->taxproductnum } qsearch( { 'table'     => 'part_pkg_taxproduct',
1044                                        'hashref'   => { 'data_vendor'=>'cch' },
1045                                        'extra_sql' => $extra_sql,
1046                                    } );
1047
1048 }
1049
1050 sub part_pkg_taxrate {
1051   my $self = shift;
1052   my ($data_vendor, $geocode, $class) = @_;
1053
1054   my $dbh = dbh;
1055   my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1056                   dbh->quote($data_vendor);
1057
1058   # CCH oddness in m2m
1059   $extra_sql .= ' AND ('.
1060     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1061                  qw(10 5 2)
1062         ).
1063     ')';
1064   # much more CCH oddness in m2m -- this is kludgy
1065   my @tpnums = $self->_expand_cch_taxproductnum($class);
1066   if (scalar(@tpnums)) {
1067     $extra_sql .= ' AND ('.
1068                             join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1069                        ')';
1070   } else {
1071     $extra_sql .= ' AND ( 0 = 1 )';
1072   }
1073
1074   my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1075   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1076   my $select   = 'DISTINCT ON(taxclassnum) *, taxproduct';
1077
1078   # should qsearch preface columns with the table to facilitate joins?
1079   qsearch( { 'table'     => 'part_pkg_taxrate',
1080              'select'    => $select,
1081              'hashref'   => { # 'data_vendor'   => $data_vendor,
1082                               # 'taxproductnum' => $self->taxproductnum,
1083                             },
1084              'addl_from' => $addl_from,
1085              'extra_sql' => $extra_sql,
1086              'order_by'  => $order_by,
1087          } );
1088 }
1089
1090 =item _rebless
1091
1092 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1093 PLAN is the object's I<plan> field.  There should be better docs
1094 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1095
1096 =cut
1097
1098 sub _rebless {
1099   my $self = shift;
1100   my $plan = $self->plan;
1101   unless ( $plan ) {
1102     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1103       if $DEBUG;
1104     return $self;
1105   }
1106   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1107   my $class = ref($self). "::$plan";
1108   warn "reblessing $self into $class" if $DEBUG;
1109   eval "use $class;";
1110   die $@ if $@;
1111   bless($self, $class) unless $@;
1112   $self;
1113 }
1114
1115 #fallbacks that eval the setup and recur fields, for backwards compat
1116
1117 sub calc_setup {
1118   my $self = shift;
1119   warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
1120   $self->_calc_eval('setup', @_);
1121 }
1122
1123 sub calc_recur {
1124   my $self = shift;
1125   warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
1126   $self->_calc_eval('recur', @_);
1127 }
1128
1129 use vars qw( $sdate @details );
1130 sub _calc_eval {
1131   #my( $self, $field, $cust_pkg ) = @_;
1132   my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
1133   *sdate = $sdateref;
1134   *details = $detailsref;
1135   $self->$field() =~ /^(.*)$/
1136     or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
1137             $self->$field(). "\n";
1138   my $prog = $1;
1139   return 0 if $prog =~ /^\s*$/;
1140   my $value = eval $prog;
1141   die $@ if $@;
1142   $value;
1143 }
1144
1145 #fallback that return 0 for old legacy packages with no plan
1146
1147 sub calc_remain { 0; }
1148 sub calc_cancel { 0; }
1149 sub calc_units  { 0; }
1150
1151 #fallback for everything except bulk.pm
1152 sub hide_svc_detail { 0; }
1153
1154 =item format OPTION DATA
1155
1156 Returns data formatted according to the function 'format' described
1157 in the plan info.  Returns DATA if no such function exists.
1158
1159 =cut
1160
1161 sub format {
1162   my ($self, $option, $data) = (shift, shift, shift);
1163   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1164     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1165   }else{
1166     $data;
1167   }
1168 }
1169
1170 =item parse OPTION DATA
1171
1172 Returns data parsed according to the function 'parse' described
1173 in the plan info.  Returns DATA if no such function exists.
1174
1175 =cut
1176
1177 sub parse {
1178   my ($self, $option, $data) = (shift, shift, shift);
1179   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1180     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1181   }else{
1182     $data;
1183   }
1184 }
1185
1186 =back
1187
1188 =cut
1189
1190 =head1 CLASS METHODS
1191
1192 =over 4
1193
1194 =cut
1195
1196 # _upgrade_data
1197 #
1198 # Used by FS::Upgrade to migrate to a new database.
1199
1200 sub _upgrade_data { # class method
1201   my($class, %opts) = @_;
1202
1203   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1204
1205   my @part_pkg = qsearch({
1206     'table'     => 'part_pkg',
1207     'extra_sql' => "WHERE ". join(' OR ',
1208                      ( map "($_ IS NOT NULL AND $_ != '' )",
1209                            qw( plandata setup recur ) ),
1210                      'plan IS NULL', "plan = '' ",
1211                    ),
1212   });
1213
1214   foreach my $part_pkg (@part_pkg) {
1215
1216     unless ( $part_pkg->plan ) {
1217
1218       $part_pkg->plan('flat');
1219
1220       if ( $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) {
1221
1222         my $opt = new FS::part_pkg_option {
1223           'pkgpart'     => $part_pkg->pkgpart,
1224           'optionname'  => 'setup_fee',
1225           'optionvalue' => $1,
1226         };
1227         my $error = $opt->insert;
1228         die $error if $error;
1229
1230         $part_pkg->setup('');
1231
1232       } else {
1233         die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1234             $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1235       }
1236
1237       if ( $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) {
1238
1239         my $opt = new FS::part_pkg_option {
1240           'pkgpart'     => $part_pkg->pkgpart,
1241           'optionname'  => 'recur_fee',
1242           'optionvalue' => $1,
1243         };
1244         my $error = $opt->insert;
1245         die $error if $error;
1246
1247         $part_pkg->recur('');
1248
1249       } else {
1250         die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1251             $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1252       }
1253
1254     }
1255
1256     $part_pkg->replace; #this should take care of plandata, right?
1257
1258   }
1259
1260 }
1261
1262 =item curuser_pkgs_sql
1263
1264 Returns an SQL fragment for searching for packages the current user can
1265 use, either via part_pkg.agentnum directly, or via agent type (see
1266 L<FS::type_pkgs>).
1267
1268 =cut
1269
1270 sub curuser_pkgs_sql {
1271   my $class = shift;
1272
1273   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1274
1275 }
1276
1277 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1278
1279 Returns an SQL fragment for searching for packages the provided agent or agents
1280 can use, either via part_pkg.agentnum directly, or via agent type (see
1281 L<FS::type_pkgs>).
1282
1283 =cut
1284
1285 sub agent_pkgs_sql {
1286   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
1287   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1288
1289   $class->_pkgs_sql(@agentnums); #is this why
1290
1291 }
1292
1293 sub _pkgs_sql {
1294   my( $class, @agentnums ) = @_;
1295   my $agentnums = join(',', @agentnums);
1296
1297   "
1298     (
1299       agentnum IS NOT NULL
1300       OR
1301       0 < ( SELECT COUNT(*)
1302               FROM type_pkgs
1303                 LEFT JOIN agent_type USING ( typenum )
1304                 LEFT JOIN agent AS typeagent USING ( typenum )
1305               WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1306                 AND typeagent.agentnum IN ($agentnums)
1307           )
1308     )
1309   ";
1310
1311 }
1312
1313 =back
1314
1315 =head1 SUBROUTINES
1316
1317 =over 4
1318
1319 =item plan_info
1320
1321 =cut
1322
1323 #false laziness w/part_export & cdr
1324 my %info;
1325 foreach my $INC ( @INC ) {
1326   warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1327   foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1328     warn "attempting to load plan info from $file\n" if $DEBUG;
1329     $file =~ /\/(\w+)\.pm$/ or do {
1330       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1331       next;
1332     };
1333     my $mod = $1;
1334     my $info = eval "use FS::part_pkg::$mod; ".
1335                     "\\%FS::part_pkg::$mod\::info;";
1336     if ( $@ ) {
1337       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1338       next;
1339     }
1340     unless ( keys %$info ) {
1341       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1342       next;
1343     }
1344     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1345     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1346       warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1347       next;
1348     }
1349     $info{$mod} = $info;
1350   }
1351 }
1352
1353 tie %plans, 'Tie::IxHash',
1354   map  { $_ => $info{$_} }
1355   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1356   keys %info;
1357
1358 sub plan_info {
1359   \%plans;
1360 }
1361
1362
1363 =back
1364
1365 =head1 NEW PLAN CLASSES
1366
1367 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
1368 found in eg/plan_template.pm.  Until then, it is suggested that you use the
1369 other modules in FS/FS/part_pkg/ as a guide.
1370
1371 =head1 BUGS
1372
1373 The delete method is unimplemented.
1374
1375 setup and recur semantics are not yet defined (and are implemented in
1376 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
1377
1378 plandata should go
1379
1380 part_pkg_taxrate is Pg specific
1381
1382 =head1 SEE ALSO
1383
1384 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1385 schema.html from the base documentation.
1386
1387 =cut
1388
1389 1;
1390