empty From address in default message templates, #15448
[freeside.git] / FS / FS / msg_template.pm
index 83acde2..1c458a0 100644 (file)
@@ -6,6 +6,21 @@ use Text::Template;
 use FS::Misc qw( generate_email send_email );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs );
 use FS::Misc qw( generate_email send_email );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs );
+use FS::UID qw( dbh );
+
+use FS::cust_main;
+use FS::cust_msg;
+use FS::template_content;
+
+use Date::Format qw( time2str );
+use HTML::Entities qw( decode_entities encode_entities ) ;
+use HTML::FormatText;
+use HTML::TreeBuilder;
+use vars qw( $DEBUG $conf );
+
+FS::UID->install_callback( sub { $conf = new FS::Conf; } );
+
+$DEBUG=0;
 
 =head1 NAME
 
 
 =head1 NAME
 
@@ -34,30 +49,19 @@ supported:
 
 =over 4
 
 
 =over 4
 
-=item msgnum
-
-primary key
-
-=item msgname
-
-msgname
+=item msgnum - primary key
 
 
-=item agentnum
+=item msgname - Name of the template.  This will appear in the user interface;
+if it needs to be localized for some users, add it to the message catalog.
 
 
-agentnum
+=item agentnum - Agent associated with this template.  Can be NULL for a 
+global template.
 
 
-=item mime_type
+=item mime_type - MIME type.  Defaults to text/html.
 
 
-mime_type
-
-=item body
-
-body
-
-=item disabled
-
-disabled
+=item from_addr - Source email address.
 
 
+=item disabled - disabled ('Y' or NULL).
 
 =back
 
 
 =back
 
@@ -78,14 +82,41 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'msg_template'; }
 
 
 sub table { 'msg_template'; }
 
-=item insert
+=item insert [ CONTENT ]
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
+A default (no locale) L<FS::template_content> object will be created.  CONTENT 
+is an optional hash containing 'subject' and 'body' for this object.
+
 =cut
 
 =cut
 
-# the insert method can be inherited from FS::Record
+sub insert {
+  my $self = shift;
+  my %content = @_;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::insert;
+  if ( !$error ) {
+    $content{'msgnum'} = $self->msgnum;
+    $content{'subject'} ||= '';
+    $content{'body'} ||= '';
+    my $template_content = new FS::template_content (\%content);
+    $error = $template_content->insert;
+  }
+
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit if $oldAutoCommit;
+  return;
+}
 
 =item delete
 
 
 =item delete
 
@@ -95,14 +126,59 @@ Delete this record from the database.
 
 # the delete method can be inherited from FS::Record
 
 
 # the delete method can be inherited from FS::Record
 
-=item replace OLD_RECORD
+=item replace [ OLD_RECORD ] [ CONTENT ]
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
+CONTENT is an optional hash containing 'subject', 'body', and 'locale'.  If 
+supplied, an L<FS::template_content> object will be created (or modified, if 
+one already exists for this locale).
+
 =cut
 
 =cut
 
-# the replace method can be inherited from FS::Record
+sub replace {
+  my $self = shift;
+  my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) 
+              ? shift
+              : $self->replace_old;
+  my %content = @_;
+  
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::replace($old);
+
+  if ( !$error and %content ) {
+    $content{'locale'} ||= '';
+    my $new_content = qsearchs('template_content', {
+                        'msgnum' => $self->msgnum,
+                        'locale' => $content{'locale'},
+                      } );
+    if ( $new_content ) {
+      $new_content->subject($content{'subject'});
+      $new_content->body($content{'body'});
+      $error = $new_content->replace;
+    }
+    else {
+      $content{'msgnum'} = $self->msgnum;
+      $new_content = new FS::template_content \%content;
+      $error = $new_content->insert;
+    }
+  }
+
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
+  $dbh->commit if $oldAutoCommit;
+  return;
+}
+    
+
 
 =item check
 
 
 =item check
 
@@ -123,8 +199,8 @@ sub check {
     || $self->ut_text('msgname')
     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
     || $self->ut_textn('mime_type')
     || $self->ut_text('msgname')
     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
     || $self->ut_textn('mime_type')
-    || $self->ut_anything('body')
     || $self->ut_enum('disabled', [ '', 'Y' ] )
     || $self->ut_enum('disabled', [ '', 'Y' ] )
+    || $self->ut_textn('from_addr')
   ;
   return $error if $error;
 
   ;
   return $error if $error;
 
@@ -133,9 +209,25 @@ sub check {
   $self->SUPER::check;
 }
 
   $self->SUPER::check;
 }
 
-=item send OPTION => VALUE, ...
+=item content_locales
 
 
-Fills in the template and emails it to the customer.
+Returns a hashref of the L<FS::template_content> objects attached to 
+this template, with the locale as key.
+
+=cut
+
+sub content_locales {
+  my $self = shift;
+  return $self->{'_content_locales'} ||= +{
+    map { $_->locale , $_ } 
+    qsearch('template_content', { 'msgnum' => $self->msgnum })
+  };
+}
+
+=item prepare OPTION => VALUE
+
+Fills in the template and returns a hash of the 'from' address, 'to' 
+addresses, subject line, and body.
 
 Options are passed as a list of name/value pairs:
 
 
 Options are passed as a list of name/value pairs:
 
@@ -147,71 +239,210 @@ Customer object (required).
 
 =item object
 
 
 =item object
 
-Additional context object (currently, can be a cust_main object, cust_pkg
-object, or cust_bill object).
+Additional context object (currently, can be a cust_main, cust_pkg, 
+cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband, 
+domain) ).  If the object is a svc_*, its cust_pkg will be fetched and 
+used for substitution.
+
+As a special case, this may be an arrayref of two objects.  Both 
+objects will be available for substitution, with their field names 
+prefixed with 'new_' and 'old_' respectively.  This is used in the 
+rt_ticket export when exporting "replace" events.
+
+=item from_config
+
+Configuration option to use as the source address, based on the customer's 
+agentnum.  If unspecified (or the named option is empty), 'invoice_from' 
+will be used.
+
+The I<from_addr> field in the template takes precedence over this.
+
+=item to
+
+Destination address.  The default is to use the customer's 
+invoicing_list addresses.  Multiple addresses may be comma-separated.
+
+=item substitutions
+
+A hash reference of additional substitutions
 
 =back
 
 =cut
 
 
 =back
 
 =cut
 
-sub send {
+sub prepare {
   my( $self, %opt ) = @_;
 
   my $cust_main = $opt{'cust_main'};
   my $object = $opt{'object'};
 
   my( $self, %opt ) = @_;
 
   my $cust_main = $opt{'cust_main'};
   my $object = $opt{'object'};
 
-  ###
-  # fill-in
-  ###
+  # localization
+  my $locale = $cust_main->locale || '';
+  warn "no locale for cust#".$cust_main->custnum."; using default content\n"
+    if $DEBUG and !$locale;
+  my $content = $self->content($cust_main->locale);
+  warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
+    if($DEBUG);
 
   my $subs = $self->substitutions;
 
   my $subs = $self->substitutions;
-  
-  use Data::Dumper;
-  warn Dumper($subs);
 
 
-  #XXX html escape this stuff
-  my %hash = map { $_ => $cust_main->$_() } @{ $subs->{'cust_main'} };
-  unless ( ! $object || $object->table eq 'cust_main' ) {
-    %hash = ( %hash, map { $_ => $object->$_() } @{ $subs->{$object->table} } );
+  ###
+  # create substitution table
+  ###  
+  my %hash;
+  my @objects = ($cust_main);
+  my @prefixes = ('');
+  my $svc;
+  if( ref $object ) {
+    if( ref($object) eq 'ARRAY' ) {
+      # [new, old], for provisioning tickets
+      push @objects, $object->[0], $object->[1];
+      push @prefixes, 'new_', 'old_';
+      $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
+    }
+    else {
+      push @objects, $object;
+      push @prefixes, '';
+      $svc = $object if $object->isa('FS::svc_Common');
+    }
+  }
+  if( $svc ) {
+    push @objects, $svc->cust_svc->cust_pkg;
+    push @prefixes, '';
+  }
+
+  foreach my $obj (@objects) {
+    my $prefix = shift @prefixes;
+    foreach my $name (@{ $subs->{$obj->table} }) {
+      if(!ref($name)) {
+        # simple case
+        $hash{$prefix.$name} = $obj->$name();
+      }
+      elsif( ref($name) eq 'ARRAY' ) {
+        # [ foo => sub { ... } ]
+        $hash{$prefix.($name->[0])} = $name->[1]->($obj);
+      }
+      else {
+        warn "bad msg_template substitution: '$name'\n";
+        #skip it?
+      } 
+    } 
+  } 
+
+  if ( $opt{substitutions} ) {
+    $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
   }
   }
-  warn Dumper(\%hash);
 
 
+  $_ = encode_entities($_ || '') foreach values(%hash);
+
+  ###
+  # clean up template
+  ###
   my $subject_tmpl = new Text::Template (
     TYPE   => 'STRING',
   my $subject_tmpl = new Text::Template (
     TYPE   => 'STRING',
-    SOURCE => $self->subject,
+    SOURCE => $content->subject,
   );
   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 
   );
   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 
+  my $body = $content->body;
+  my ($skin, $guts) = eviscerate($body);
+  @$guts = map { 
+    $_ = decode_entities($_); # turn all punctuation back into itself
+    s/\r//gs;           # remove \r's
+    s/<br[^>]*>/\n/gsi; # and <br /> tags
+    s/<p>/\n/gsi;       # and <p>
+    s/<\/p>//gsi;       # and </p>
+    s/\240/ /gs;        # and &nbsp;
+    $_
+  } @$guts;
+  
+  $body = '{ use Date::Format qw(time2str); "" }';
+  while(@$skin || @$guts) {
+    $body .= shift(@$skin) || '';
+    $body .= shift(@$guts) || '';
+  }
+
+  ###
+  # fill-in
+  ###
+
   my $body_tmpl = new Text::Template (
   my $body_tmpl = new Text::Template (
-    TYPE   => 'STRING',
-    SOURCE => $self->body,
+    TYPE          => 'STRING',
+    SOURCE        => $body,
   );
   );
-  my $body = $body_tmpl->fill_in( HASH => \%hash );
+
+  $body = $body_tmpl->fill_in( HASH => \%hash );
 
   ###
   # and email
   ###
 
 
   ###
   # and email
   ###
 
-  my @to = $cust_main->invoicing_list_emailonly;
-  #unless (@to) { #XXX do something }
-
-  my $conf = new FS::Conf;
-
-  send_email(
-    generate_email(
-       #XXX override from in event?
-      'from' => scalar( $conf->config('invoice_from', $cust_main->agentnum) ),
-      'to'   => \@to,
-      'subject'   => $subject,
-      'html_body' => $body,
-      #XXX auto-make a text copy w/HTML::FormatText?
-      #  alas, us luddite mutt/pine users just aren't that big a deal
-    )
+  my @to;
+  if ( exists($opt{'to'}) ) {
+    @to = split(/\s*,\s*/, $opt{'to'});
+  }
+  else {
+    @to = $cust_main->invoicing_list_emailonly;
+  }
+  # no warning when preparing with no destination
+
+  my $from_addr = $self->from_addr;
+
+  if ( !$from_addr ) {
+    if ( $opt{'from_config'} ) {
+      $from_addr = scalar( $conf->config($opt{'from_config'}, 
+                                         $cust_main->agentnum) );
+    }
+    $from_addr ||= scalar( $conf->config('invoice_from',
+                                         $cust_main->agentnum) );
+  }
+#  my @cust_msg = ();
+#  if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
+#    my $cust_msg = FS::cust_msg->new({
+#        'custnum' => $cust_main->custnum,
+#        'msgnum'  => $self->msgnum,
+#        'status'  => 'prepared',
+#      });
+#    $cust_msg->insert;
+#    @cust_msg = ('cust_msg' => $cust_msg);
+#  }
+
+  (
+    'custnum' => $cust_main->custnum,
+    'msgnum'  => $self->msgnum,
+    'from' => $from_addr,
+    'to'   => \@to,
+    'bcc'  => $self->bcc_addr || undef,
+    'subject'   => $subject,
+    'html_body' => $body,
+    'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
+                    )->format( HTML::TreeBuilder->new_from_content($body) ),
   );
 
 }
 
   );
 
 }
 
+=item send OPTION => VALUE
+
+Fills in the template and sends it to the customer.  Options are as for 
+'prepare'.
+
+=cut
+
+# broken out from prepare() in case we want to queue the sending,
+# preview it, etc.
+sub send {
+  my $self = shift;
+  send_email(generate_email($self->prepare(@_)));
+}
+
+# helper sub for package dates
+my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
+
+#my $conf = new FS::Conf;
+
 #return contexts and fill-in values
 #return contexts and fill-in values
+# If you add anything, be sure to add a description in 
+# httemplate/edit/msg_template.html.
 sub substitutions {
   { 'cust_main' => [qw(
       display_custnum agentnum agent_name
 sub substitutions {
   { 'cust_main' => [qw(
       display_custnum agentnum agent_name
@@ -229,28 +460,261 @@ sub substitutions {
       ship_country
       ship_daytime ship_night ship_fax
 
       ship_country
       ship_daytime ship_night ship_fax
 
-      payby paymask payname paytype payip
+      paymask payname paytype payip
       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
       classname categoryname
       balance
       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
       classname categoryname
       balance
+      credit_limit
       invoicing_list_emailonly
       cust_status ucfirst_cust_status cust_statuscolor
       invoicing_list_emailonly
       cust_status ucfirst_cust_status cust_statuscolor
-    )],
-    #XXX make these pretty: signupdate dundate paydate_monthyear usernum
-    # next_bill_date
-
-    'cust_pkg'  => [qw(
-    )],
-    #XXX these are going to take more pretty-ing up
 
 
+      signupdate dundate
+      packages recurdates
+      ),
+      [ expdate           => sub { shift->paydate_epoch } ], #compatibility
+      [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
+      [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
+      [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
+      [ otaker_first      => sub { shift->access_user->first } ],
+      [ otaker_last       => sub { shift->access_user->last } ],
+      [ payby             => sub { FS::payby->shortname(shift->payby) } ],
+      [ company_name      => sub { 
+          $conf->config('company_name', shift->agentnum) 
+        } ],
+      [ company_address   => sub {
+          $conf->config('company_address', shift->agentnum)
+        } ],
+      [ company_phonenum  => sub {
+          $conf->config('company_phonenum', shift->agentnum)
+        } ],
+    ],
+    # next_bill_date
+    'cust_pkg'  => [qw( 
+      pkgnum pkg_label pkg_label_long
+      location_label
+      status statuscolor
+    
+      start_date setup bill last_bill 
+      adjourn susp expire 
+      labels_short
+      ),
+      [ pkg               => sub { shift->part_pkg->pkg } ],
+      [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
+      [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
+      [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
+      [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
+      [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
+      [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
+      [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
+      [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
+      [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
+    ],
     'cust_bill' => [qw(
       invnum
     'cust_bill' => [qw(
       invnum
+      _date
     )],
     #XXX not really thinking about cust_bill substitutions quite yet
     )],
     #XXX not really thinking about cust_bill substitutions quite yet
-
+    
+    # for welcome and limit warning messages
+    'svc_acct' => [qw(
+      svcnum
+      username
+      domain
+      ),
+      [ password          => sub { shift->getfield('_password') } ],
+    ],
+    'svc_domain' => [qw(
+      svcnum
+      domain
+      ),
+      [ registrar         => sub {
+          my $registrar = qsearchs('registrar', 
+            { registrarnum => shift->registrarnum} );
+          $registrar ? $registrar->registrarname : ''
+        }
+      ],
+      [ catchall          => sub { 
+          my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
+          $svc_acct ? $svc_acct->email : ''
+        }
+      ],
+    ],
+    'svc_phone' => [qw(
+      svcnum
+      phonenum
+      countrycode
+      domain
+      )
+    ],
+    'svc_broadband' => [qw(
+      svcnum
+      speed_up
+      speed_down
+      ip_addr
+      mac_addr
+      )
+    ],
+    # for payment receipts
+    'cust_pay' => [qw(
+      paynum
+      _date
+      ),
+      [ paid              => sub { sprintf("%.2f", shift->paid) } ],
+      # overrides the one in cust_main in cases where a cust_pay is passed
+      [ payby             => sub { FS::payby->shortname(shift->payby) } ],
+      [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
+      [ payinfo           => sub { 
+          my $cust_pay = shift;
+          ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
+            $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
+        } ],
+    ],
+    # for payment decline messages
+    # try to support all cust_pay fields
+    # 'error' is a special case, it contains the raw error from the gateway
+    'cust_pay_pending' => [qw(
+      _date
+      error
+      ),
+      [ paid              => sub { sprintf("%.2f", shift->paid) } ],
+      [ payby             => sub { FS::payby->shortname(shift->payby) } ],
+      [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
+      [ payinfo           => sub {
+          my $pending = shift;
+          ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
+            $pending->paymask : $pending->decrypt($pending->payinfo)
+        } ],
+    ],
   };
 }
 
   };
 }
 
+=item content LOCALE
+
+Returns the L<FS::template_content> object appropriate to LOCALE, if there 
+is one.  If not, returns the one with a NULL locale.
+
+=cut
+
+sub content {
+  my $self = shift;
+  my $locale = shift;
+  qsearchs('template_content', 
+            { 'msgnum' => $self->msgnum, 'locale' => $locale }) || 
+  qsearchs('template_content',
+            { 'msgnum' => $self->msgnum, 'locale' => '' });
+}
+
+=item agent
+
+Returns the L<FS::agent> object for this template.
+
+=cut
+
+sub agent {
+  qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
+}
+
+sub _upgrade_data {
+  my ($self, %opts) = @_;
+
+  my @fixes = (
+    [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
+    [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
+    [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
+    [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
+    [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
+    [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
+    [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
+  );
+  my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
+  foreach my $agentnum (@agentnums) {
+    foreach (@fixes) {
+      my ($newname, $oldname, $subject, $from, $bcc) = @$_;
+      if ($conf->exists($oldname, $agentnum)) {
+        my $new = new FS::msg_template({
+          'msgname'   => $oldname,
+          'agentnum'  => $agentnum,
+          'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
+          'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
+          'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
+          'mime_type' => 'text/html',
+          'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
+        });
+        my $error = $new->insert;
+        die $error if $error;
+        $conf->set($newname, $new->msgnum, $agentnum);
+        $conf->delete($oldname, $agentnum);
+        $conf->delete($from, $agentnum) if $from;
+        $conf->delete($subject, $agentnum) if $subject;
+      }
+    }
+  }
+  foreach my $msg_template ( qsearch('msg_template', {}) ) {
+    if ( $msg_template->subject || $msg_template->body ) {
+      # create new default content
+      my %content;
+      foreach ('subject','body') {
+        $content{$_} = $msg_template->$_;
+        $msg_template->setfield($_, '');
+      }
+
+      my $error = $msg_template->replace(%content);
+      die $error if $error;
+    }
+  }
+}
+
+sub eviscerate {
+  # Every bit as pleasant as it sounds.
+  #
+  # We do this because Text::Template::Preprocess doesn't
+  # actually work.  It runs the entire template through 
+  # the preprocessor, instead of the code segments.  Which 
+  # is a shame, because Text::Template already contains
+  # the code to do this operation.
+  my $body = shift;
+  my (@outside, @inside);
+  my $depth = 0;
+  my $chunk = '';
+  while($body || $chunk) {
+    my ($first, $delim, $rest);
+    # put all leading non-delimiters into $first
+    ($first, $rest) =
+        ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
+    $chunk .= $first;
+    # put a leading delimiter into $delim if there is one
+    ($delim, $rest) =
+      ($rest =~ /^([{}]?)(.*)$/s);
+
+    if( $delim eq '{' ) {
+      $chunk .= '{';
+      if( $depth == 0 ) {
+        push @outside, $chunk;
+        $chunk = '';
+      }
+      $depth++;
+    }
+    elsif( $delim eq '}' ) {
+      $depth--;
+      if( $depth == 0 ) {
+        push @inside, $chunk;
+        $chunk = '';
+      }
+      $chunk .= '}';
+    }
+    else {
+      # no more delimiters
+      if( $depth == 0 ) {
+        push @outside, $chunk . $rest;
+      } # else ? something wrong
+      last;
+    }
+    $body = $rest;
+  }
+  (\@outside, \@inside);
+}
+
 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS