FS/FS/msg_template.pm

   1 package FS::msg_template;
   2
   3 use strict;
   4 use base qw( FS::Record );
   5 use Text::Template;
   6 use FS::Misc qw( generate_email send_email );
   7 use FS::Conf;
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::UID qw( dbh );
  10
  11 use FS::cust_main;
  12 use FS::cust_msg;
  13 use FS::template_content;
  14
  15 use Date::Format qw( time2str );
  16 use HTML::Entities qw( decode_entities encode_entities ) ;
  17 use HTML::FormatText;
  18 use HTML::TreeBuilder;
  19 use vars qw( $DEBUG $conf );
  20
  21 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
  22
  23 $DEBUG=0;
  24
  25 =head1 NAME
  26
  27 FS::msg_template - Object methods for msg_template records
  28
  29 =head1 SYNOPSIS
  30
  31   use FS::msg_template;
  32
  33   $record = new FS::msg_template \%hash;
  34   $record = new FS::msg_template { 'column' => 'value' };
  35
  36   $error = $record->insert;
  37
  38   $error = $new_record->replace($old_record);
  39
  40   $error = $record->delete;
  41
  42   $error = $record->check;
  43
  44 =head1 DESCRIPTION
  45
  46 An FS::msg_template object represents a customer message template.
  47 FS::msg_template inherits from FS::Record.  The following fields are currently
  48 supported:
  49
  50 =over 4
  51
  52 =item msgnum - primary key
  53
  54 =item msgname - Name of the template.  This will appear in the user interface;
  55 if it needs to be localized for some users, add it to the message catalog.
  56
  57 =item agentnum - Agent associated with this template.  Can be NULL for a
  58 global template.
  59
  60 =item mime_type - MIME type.  Defaults to text/html.
  61
  62 =item from_addr - Source email address.
  63
  64 =item disabled - disabled ('Y' or NULL).
  65
  66 =back
  67
  68 =head1 METHODS
  69
  70 =over 4
  71
  72 =item new HASHREF
  73
  74 Creates a new template.  To add the template to the database, see L<"insert">.
  75
  76 Note that this stores the hash reference, not a distinct copy of the hash it
  77 points to.  You can ask the object for a copy with the I<hash> method.
  78
  79 =cut
  80
  81 # the new method can be inherited from FS::Record, if a table method is defined
  82
  83 sub table { 'msg_template'; }
  84
  85 =item insert [ CONTENT ]
  86
  87 Adds this record to the database.  If there is an error, returns the error,
  88 otherwise returns false.
  89
  90 A default (no locale) L<FS::template_content> object will be created.  CONTENT
  91 is an optional hash containing 'subject' and 'body' for this object.
  92
  93 =cut
  94
  95 sub insert {
  96   my $self = shift;
  97   my %content = @_;
  98
  99   my $oldAutoCommit = $FS::UID::AutoCommit;
 100   local $FS::UID::AutoCommit = 0;
 101   my $dbh = dbh;
 102
 103   my $error = $self->SUPER::insert;
 104   if ( !$error ) {
 105     $content{'msgnum'} = $self->msgnum;
 106     $content{'subject'} ||= '';
 107     $content{'body'} ||= '';
 108     my $template_content = new FS::template_content (\%content);
 109     $error = $template_content->insert;
 110   }
 111
 112   if ( $error ) {
 113     $dbh->rollback if $oldAutoCommit;
 114     return $error;
 115   }
 116
 117   $dbh->commit if $oldAutoCommit;
 118   return;
 119 }
 120
 121 =item delete
 122
 123 Delete this record from the database.
 124
 125 =cut
 126
 127 # the delete method can be inherited from FS::Record
 128
 129 =item replace [ OLD_RECORD ] [ CONTENT ]
 130
 131 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 132 returns the error, otherwise returns false.
 133
 134 CONTENT is an optional hash containing 'subject', 'body', and 'locale'.  If
 135 supplied, an L<FS::template_content> object will be created (or modified, if
 136 one already exists for this locale).
 137
 138 =cut
 139
 140 sub replace {
 141   my $self = shift;
 142   my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
 143               ? shift
 144               : $self->replace_old;
 145   my %content = @_;
 146
 147   my $oldAutoCommit = $FS::UID::AutoCommit;
 148   local $FS::UID::AutoCommit = 0;
 149   my $dbh = dbh;
 150
 151   my $error = $self->SUPER::replace($old);
 152
 153   if ( !$error and %content ) {
 154     $content{'locale'} ||= '';
 155     my $new_content = qsearchs('template_content', {
 156                         'msgnum' => $self->msgnum,
 157                         'locale' => $content{'locale'},
 158                       } );
 159     if ( $new_content ) {
 160       $new_content->subject($content{'subject'});
 161       $new_content->body($content{'body'});
 162       $error = $new_content->replace;
 163     }
 164     else {
 165       $content{'msgnum'} = $self->msgnum;
 166       $new_content = new FS::template_content \%content;
 167       $error = $new_content->insert;
 168     }
 169   }
 170
 171   if ( $error ) {
 172     $dbh->rollback if $oldAutoCommit;
 173     return $error;
 174   }
 175
 176   warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
 177   $dbh->commit if $oldAutoCommit;
 178   return;
 179 }
 180
 181
 182
 183 =item check
 184
 185 Checks all fields to make sure this is a valid template.  If there is
 186 an error, returns the error, otherwise returns false.  Called by the insert
 187 and replace methods.
 188
 189 =cut
 190
 191 # the check method should currently be supplied - FS::Record contains some
 192 # data checking routines
 193
 194 sub check {
 195   my $self = shift;
 196
 197   my $error =
 198     $self->ut_numbern('msgnum')
 199     || $self->ut_text('msgname')
 200     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
 201     || $self->ut_textn('mime_type')
 202     || $self->ut_enum('disabled', [ '', 'Y' ] )
 203     || $self->ut_textn('from_addr')
 204   ;
 205   return $error if $error;
 206
 207   $self->mime_type('text/html') unless $self->mime_type;
 208
 209   $self->SUPER::check;
 210 }
 211
 212 =item content_locales
 213
 214 Returns a hashref of the L<FS::template_content> objects attached to
 215 this template, with the locale as key.
 216
 217 =cut
 218
 219 sub content_locales {
 220   my $self = shift;
 221   return $self->{'_content_locales'} ||= +{
 222     map { $_->locale , $_ }
 223     qsearch('template_content', { 'msgnum' => $self->msgnum })
 224   };
 225 }
 226
 227 =item prepare OPTION => VALUE
 228
 229 Fills in the template and returns a hash of the 'from' address, 'to'
 230 addresses, subject line, and body.
 231
 232 Options are passed as a list of name/value pairs:
 233
 234 =over 4
 235
 236 =item cust_main
 237
 238 Customer object (required).
 239
 240 =item object
 241
 242 Additional context object (currently, can be a cust_main, cust_pkg,
 243 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
 244 domain) ).  If the object is a svc_*, its cust_pkg will be fetched and
 245 used for substitution.
 246
 247 As a special case, this may be an arrayref of two objects.  Both
 248 objects will be available for substitution, with their field names
 249 prefixed with 'new_' and 'old_' respectively.  This is used in the
 250 rt_ticket export when exporting "replace" events.
 251
 252 =item from_config
 253
 254 Configuration option to use as the source address, based on the customer's
 255 agentnum.  If unspecified (or the named option is empty), 'invoice_from'
 256 will be used.
 257
 258 The I<from_addr> field in the template takes precedence over this.
 259
 260 =item to
 261
 262 Destination address.  The default is to use the customer's
 263 invoicing_list addresses.  Multiple addresses may be comma-separated.
 264
 265 =item substitutions
 266
 267 A hash reference of additional substitutions
 268
 269 =back
 270
 271 =cut
 272
 273 sub prepare {
 274   my( $self, %opt ) = @_;
 275
 276   my $cust_main = $opt{'cust_main'};
 277   my $object = $opt{'object'};
 278
 279   # localization
 280   my $locale = $cust_main->locale || '';
 281   warn "no locale for cust#".$cust_main->custnum."; using default content\n"
 282     if $DEBUG and !$locale;
 283   my $content = $self->content($cust_main->locale);
 284   warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
 285     if($DEBUG);
 286
 287   my $subs = $self->substitutions;
 288
 289   ###
 290   # create substitution table
 291   ###
 292   my %hash;
 293   my @objects = ($cust_main);
 294   my @prefixes = ('');
 295   my $svc;
 296   if( ref $object ) {
 297     if( ref($object) eq 'ARRAY' ) {
 298       # [new, old], for provisioning tickets
 299       push @objects, $object->[0], $object->[1];
 300       push @prefixes, 'new_', 'old_';
 301       $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
 302     }
 303     else {
 304       push @objects, $object;
 305       push @prefixes, '';
 306       $svc = $object if $object->isa('FS::svc_Common');
 307     }
 308   }
 309   if( $svc ) {
 310     push @objects, $svc->cust_svc->cust_pkg;
 311     push @prefixes, '';
 312   }
 313
 314   foreach my $obj (@objects) {
 315     my $prefix = shift @prefixes;
 316     foreach my $name (@{ $subs->{$obj->table} }) {
 317       if(!ref($name)) {
 318         # simple case
 319         $hash{$prefix.$name} = $obj->$name();
 320       }
 321       elsif( ref($name) eq 'ARRAY' ) {
 322         # [ foo => sub { ... } ]
 323         $hash{$prefix.($name->[0])} = $name->[1]->($obj);
 324       }
 325       else {
 326         warn "bad msg_template substitution: '$name'\n";
 327         #skip it?
 328       }
 329     }
 330   }
 331
 332   if ( $opt{substitutions} ) {
 333     $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
 334   }
 335
 336   $_ = encode_entities($_ || '') foreach values(%hash);
 337
 338   ###
 339   # clean up template
 340   ###
 341   my $subject_tmpl = new Text::Template (
 342     TYPE   => 'STRING',
 343     SOURCE => $content->subject,
 344   );
 345   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 346
 347   my $body = $content->body;
 348   my ($skin, $guts) = eviscerate($body);
 349   @$guts = map {
 350     $_ = decode_entities($_); # turn all punctuation back into itself
 351     s/\r//gs;           # remove \r's
 352     s/<br[^>]*>/\n/gsi; # and <br /> tags
 353     s/<p>/\n/gsi;       # and <p>
 354     s/<\/p>//gsi;       # and </p>
 355     s/\240/ /gs;        # and &nbsp;
 356     $_
 357   } @$guts;
 358
 359   $body = '{ use Date::Format qw(time2str); "" }';
 360   while(@$skin || @$guts) {
 361     $body .= shift(@$skin) || '';
 362     $body .= shift(@$guts) || '';
 363   }
 364
 365   ###
 366   # fill-in
 367   ###
 368
 369   my $body_tmpl = new Text::Template (
 370     TYPE          => 'STRING',
 371     SOURCE        => $body,
 372   );
 373
 374   $body = $body_tmpl->fill_in( HASH => \%hash );
 375
 376   ###
 377   # and email
 378   ###
 379
 380   my @to;
 381   if ( exists($opt{'to'}) ) {
 382     @to = split(/\s*,\s*/, $opt{'to'});
 383   }
 384   else {
 385     @to = $cust_main->invoicing_list_emailonly;
 386   }
 387   # no warning when preparing with no destination
 388
 389   my $from_addr = $self->from_addr;
 390
 391   if ( !$from_addr ) {
 392     if ( $opt{'from_config'} ) {
 393       $from_addr = scalar( $conf->config($opt{'from_config'},
 394                                          $cust_main->agentnum) );
 395     }
 396     $from_addr ||= scalar( $conf->config('invoice_from',
 397                                          $cust_main->agentnum) );
 398   }
 399 #  my @cust_msg = ();
 400 #  if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
 401 #    my $cust_msg = FS::cust_msg->new({
 402 #        'custnum' => $cust_main->custnum,
 403 #        'msgnum'  => $self->msgnum,
 404 #        'status'  => 'prepared',
 405 #      });
 406 #    $cust_msg->insert;
 407 #    @cust_msg = ('cust_msg' => $cust_msg);
 408 #  }
 409
 410   (
 411     'custnum' => $cust_main->custnum,
 412     'msgnum'  => $self->msgnum,
 413     'from' => $from_addr,
 414     'to'   => \@to,
 415     'bcc'  => $self->bcc_addr || undef,
 416     'subject'   => $subject,
 417     'html_body' => $body,
 418     'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
 419                     )->format( HTML::TreeBuilder->new_from_content($body) ),
 420   );
 421
 422 }
 423
 424 =item send OPTION => VALUE
 425
 426 Fills in the template and sends it to the customer.  Options are as for
 427 'prepare'.
 428
 429 =cut
 430
 431 # broken out from prepare() in case we want to queue the sending,
 432 # preview it, etc.
 433 sub send {
 434   my $self = shift;
 435   send_email(generate_email($self->prepare(@_)));
 436 }
 437
 438 # helper sub for package dates
 439 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 440
 441 # helper sub for usage-related messages
 442 my $usage_warning = sub {
 443   my $svc = shift;
 444   foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
 445     my $amount = $svc->$col; next if $amount eq '';
 446     my $method = $col.'_threshold';
 447     my $threshold = $svc->$method; next if $threshold eq '';
 448     return [$col, $amount, $threshold] if $amount <= $threshold;
 449     # this only returns the first one that's below threshold, if there are
 450     # several.
 451   }
 452   return ['', '', ''];
 453 };
 454
 455 #my $conf = new FS::Conf;
 456
 457 #return contexts and fill-in values
 458 # If you add anything, be sure to add a description in
 459 # httemplate/edit/msg_template.html.
 460 sub substitutions {
 461   { 'cust_main' => [qw(
 462       display_custnum agentnum agent_name
 463
 464       last first company
 465       name name_short contact contact_firstlast
 466       address1 address2 city county state zip
 467       country
 468       daytime night mobile fax
 469
 470       has_ship_address
 471       ship_name ship_name_short ship_contact ship_contact_firstlast
 472       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
 473       ship_country
 474
 475       paymask payname paytype payip
 476       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
 477       classname categoryname
 478       balance
 479       credit_limit
 480       invoicing_list_emailonly
 481       cust_status ucfirst_cust_status cust_statuscolor
 482
 483       signupdate dundate
 484       packages recurdates
 485       ),
 486       #compatibility: obsolete ship_ fields - use the non-ship versions
 487       map (
 488         { my $field = $_;
 489           [ "ship_$field"   => sub { shift->$field } ]
 490         }
 491         qw( last first company daytime night fax )
 492       ),
 493       # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
 494       # still work, though
 495       [ expdate           => sub { shift->paydate_epoch } ], #compatibility
 496       [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
 497       [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
 498       [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
 499       [ otaker_first      => sub { shift->access_user->first } ],
 500       [ otaker_last       => sub { shift->access_user->last } ],
 501       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 502       [ company_name      => sub {
 503           $conf->config('company_name', shift->agentnum)
 504         } ],
 505       [ company_address   => sub {
 506           $conf->config('company_address', shift->agentnum)
 507         } ],
 508       [ company_phonenum  => sub {
 509           $conf->config('company_phonenum', shift->agentnum)
 510         } ],
 511     ],
 512     # next_bill_date
 513     'cust_pkg'  => [qw(
 514       pkgnum pkg_label pkg_label_long
 515       location_label
 516       status statuscolor
 517
 518       start_date setup bill last_bill
 519       adjourn susp expire
 520       labels_short
 521       ),
 522       [ pkg               => sub { shift->part_pkg->pkg } ],
 523       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
 524       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
 525       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
 526       [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
 527       [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
 528       [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
 529       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
 530       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
 531       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
 532     ],
 533     'cust_bill' => [qw(
 534       invnum
 535       _date
 536     )],
 537     #XXX not really thinking about cust_bill substitutions quite yet
 538
 539     # for welcome and limit warning messages
 540     'svc_acct' => [qw(
 541       svcnum
 542       username
 543       domain
 544       ),
 545       [ password          => sub { shift->getfield('_password') } ],
 546       [ column            => sub { &$usage_warning(shift)->[0] } ],
 547       [ amount            => sub { &$usage_warning(shift)->[1] } ],
 548       [ threshold         => sub { &$usage_warning(shift)->[2] } ],
 549     ],
 550     'svc_domain' => [qw(
 551       svcnum
 552       domain
 553       ),
 554       [ registrar         => sub {
 555           my $registrar = qsearchs('registrar',
 556             { registrarnum => shift->registrarnum} );
 557           $registrar ? $registrar->registrarname : ''
 558         }
 559       ],
 560       [ catchall          => sub {
 561           my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
 562           $svc_acct ? $svc_acct->email : ''
 563         }
 564       ],
 565     ],
 566     'svc_phone' => [qw(
 567       svcnum
 568       phonenum
 569       countrycode
 570       domain
 571       )
 572     ],
 573     'svc_broadband' => [qw(
 574       svcnum
 575       speed_up
 576       speed_down
 577       ip_addr
 578       mac_addr
 579       )
 580     ],
 581     # for payment receipts
 582     'cust_pay' => [qw(
 583       paynum
 584       _date
 585       ),
 586       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 587       # overrides the one in cust_main in cases where a cust_pay is passed
 588       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 589       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 590       [ payinfo           => sub {
 591           my $cust_pay = shift;
 592           ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
 593             $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
 594         } ],
 595     ],
 596     # for payment decline messages
 597     # try to support all cust_pay fields
 598     # 'error' is a special case, it contains the raw error from the gateway
 599     'cust_pay_pending' => [qw(
 600       _date
 601       error
 602       ),
 603       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 604       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 605       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 606       [ payinfo           => sub {
 607           my $pending = shift;
 608           ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
 609             $pending->paymask : $pending->decrypt($pending->payinfo)
 610         } ],
 611     ],
 612   };
 613 }
 614
 615 =item content LOCALE
 616
 617 Returns the L<FS::template_content> object appropriate to LOCALE, if there
 618 is one.  If not, returns the one with a NULL locale.
 619
 620 =cut
 621
 622 sub content {
 623   my $self = shift;
 624   my $locale = shift;
 625   qsearchs('template_content',
 626             { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
 627   qsearchs('template_content',
 628             { 'msgnum' => $self->msgnum, 'locale' => '' });
 629 }
 630
 631 =item agent
 632
 633 Returns the L<FS::agent> object for this template.
 634
 635 =cut
 636
 637 sub agent {
 638   qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
 639 }
 640
 641 sub _upgrade_data {
 642   my ($self, %opts) = @_;
 643
 644   my @fixes = (
 645     [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
 646     [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
 647     [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
 648     [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
 649     [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
 650     [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
 651     [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
 652   );
 653
 654   my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
 655   foreach my $agentnum (@agentnums) {
 656     foreach (@fixes) {
 657       my ($newname, $oldname, $subject, $from, $bcc) = @$_;
 658       if ($conf->exists($oldname, $agentnum)) {
 659         my $new = new FS::msg_template({
 660           'msgname'   => $oldname,
 661           'agentnum'  => $agentnum,
 662           'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
 663           'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
 664           'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
 665           'mime_type' => 'text/html',
 666           'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
 667         });
 668         my $error = $new->insert;
 669         die $error if $error;
 670         $conf->set($newname, $new->msgnum, $agentnum);
 671         $conf->delete($oldname, $agentnum);
 672         $conf->delete($from, $agentnum) if $from;
 673         $conf->delete($subject, $agentnum) if $subject;
 674       }
 675     }
 676   }
 677   foreach my $msg_template ( qsearch('msg_template', {}) ) {
 678     if ( $msg_template->subject || $msg_template->body ) {
 679       # create new default content
 680       my %content;
 681       $content{subject} = $msg_template->subject;
 682       $msg_template->set('subject', '');
 683
 684       # work around obscure Pg/DBD bug
 685       # https://rt.cpan.org/Public/Bug/Display.html?id=60200
 686       # (though the right fix is to upgrade DBD)
 687       my $body = $msg_template->body;
 688       if ( $body =~ /^x([0-9a-f]+)$/ ) {
 689         # there should be no real message templates that look like that
 690         warn "converting template body to TEXT\n";
 691         $body = pack('H*', $1);
 692       }
 693       $content{body} = $body;
 694       $msg_template->set('body', '');
 695
 696       my $error = $msg_template->replace(%content);
 697       die $error if $error;
 698     }
 699   }
 700 }
 701
 702 sub eviscerate {
 703   # Every bit as pleasant as it sounds.
 704   #
 705   # We do this because Text::Template::Preprocess doesn't
 706   # actually work.  It runs the entire template through
 707   # the preprocessor, instead of the code segments.  Which
 708   # is a shame, because Text::Template already contains
 709   # the code to do this operation.
 710   my $body = shift;
 711   my (@outside, @inside);
 712   my $depth = 0;
 713   my $chunk = '';
 714   while($body || $chunk) {
 715     my ($first, $delim, $rest);
 716     # put all leading non-delimiters into $first
 717     ($first, $rest) =
 718         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
 719     $chunk .= $first;
 720     # put a leading delimiter into $delim if there is one
 721     ($delim, $rest) =
 722       ($rest =~ /^([{}]?)(.*)$/s);
 723
 724     if( $delim eq '{' ) {
 725       $chunk .= '{';
 726       if( $depth == 0 ) {
 727         push @outside, $chunk;
 728         $chunk = '';
 729       }
 730       $depth++;
 731     }
 732     elsif( $delim eq '}' ) {
 733       $depth--;
 734       if( $depth == 0 ) {
 735         push @inside, $chunk;
 736         $chunk = '';
 737       }
 738       $chunk .= '}';
 739     }
 740     else {
 741       # no more delimiters
 742       if( $depth == 0 ) {
 743         push @outside, $chunk . $rest;
 744       } # else ? something wrong
 745       last;
 746     }
 747     $body = $rest;
 748   }
 749   (\@outside, \@inside);
 750 }
 751
 752 =back
 753
 754 =head1 BUGS
 755
 756 =head1 SEE ALSO
 757
 758 L<FS::Record>, schema.html from the base documentation.
 759
 760 =cut
 761
 762 1;
 763