From: Moritz Bunkus <m.bunkus@linet-services.de>
Date: Thu, 13 Jan 2011 10:37:58 +0000 (+0100)
Subject: Merge branch 'master' into rb-wiederkehrende-rechnungen
X-Git-Tag: release-2.6.3~61^2~9^2~3^2~15^2~29
X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/commitdiff_plain/f9c7abfae65b79945beb7e9260942bc94876248a?hp=2cf0bf46e2d6372ad8402d73e2ab1e7cc59b122e

Merge branch 'master' into rb-wiederkehrende-rechnungen
---

diff --git a/.gitignore b/.gitignore
index 25b8d194c..2ecef792d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,3 +2,6 @@ tags
 crm
 /users/datev-export*
 /users/templates-cache/
+/users/pid/
+/config/task_server.conf
+/config/periodic_invoices.conf
diff --git a/SL/BackgroundJob/ALL.pm b/SL/BackgroundJob/ALL.pm
new file mode 100644
index 000000000..be357a612
--- /dev/null
+++ b/SL/BackgroundJob/ALL.pm
@@ -0,0 +1,9 @@
+package SL::BackgroundJob::ALL;
+
+use strict;
+
+use SL::BackgroundJob::Base;
+use SL::BackgroundJob::CleanBackgroundJobHistory;
+
+1;
+
diff --git a/SL/BackgroundJob/Base.pm b/SL/BackgroundJob/Base.pm
new file mode 100644
index 000000000..27f608129
--- /dev/null
+++ b/SL/BackgroundJob/Base.pm
@@ -0,0 +1,73 @@
+package SL::BackgroundJob::Base;
+
+use strict;
+
+use parent qw(Rose::Object);
+
+use SL::DB::BackgroundJob;
+
+sub create_standard_job {
+  my $self_or_class = shift;
+  my $cron_spec     = shift;
+
+  my $package       = ref($self_or_class) || $self_or_class;
+  $package          =~ s/SL::BackgroundJob:://;
+
+  my %params        = (cron_spec    => $cron_spec || '* * * * *',
+                       type         => 'interval',
+                       active       => 1,
+                       package_name => $package);
+
+  my $job = SL::DB::Manager::BackgroundJob->find_by(package_name => $params{package_name});
+  if (!$job) {
+    $job = SL::DB::BackgroundJob->new(%params)->update_next_run_at;
+  } else {
+    $job->assign_attributes(%params)->update_next_run_at;
+  }
+
+  return $job;
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+SL::BackgroundJob::Base - Base class for all background jobs
+
+=head1 SYNOPSIS
+
+All background jobs are derived from this class. Each job gets its own
+class which must implement the C<run> method.
+
+There are two types of background jobs: periodic jobs and jobs that
+are run once. Periodic jobs have a CRON spec associated with them that
+determines the points in time when the job is supposed to be run.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<create_standard_job $cron_spec>
+
+Creates or updates an entry in the database for the current job. If
+the C<background_jobs> table contains an entry for the current class
+(as determined by C<ref($self)>) then that entry is updated and
+re-activated if it was disabled. Otherwise a new entry is created.
+
+This function can be called both as a member or as a class function.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/BackgroundJob/CleanBackgroundJobHistory.pm b/SL/BackgroundJob/CleanBackgroundJobHistory.pm
new file mode 100644
index 000000000..6ec99f800
--- /dev/null
+++ b/SL/BackgroundJob/CleanBackgroundJobHistory.pm
@@ -0,0 +1,64 @@
+package SL::BackgroundJob::CleanBackgroundJobHistory;
+
+use strict;
+
+use parent qw(SL::BackgroundJob::Base);
+
+use SL::DB::BackgroundJobHistory;
+
+sub create_job {
+  $_[0]->create_standard_job('0 3 * * *'); # daily at 3:00 am
+}
+
+sub run {
+  my $self    = shift;
+  my $db_obj  = shift;
+
+  my $options = $db_obj->data_as_hash;
+  $options->{retention_success} ||= 14;
+  $options->{retention_failure} ||= 3 * 30;
+
+  my $today = DateTime->today_local;
+
+  for my $status (qw(success failure)) {
+    SL::DB::Manager::BackgroundJobHistory->delete_all(where =>  [ status => $status,
+                                                                  run_at => { lt => $today->clone->subtract(days => $options->{"retention_${status}"}) } ]);
+  }
+
+  return 1;
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+SL::BackgroundJob::CleanBackgroundJobHistory - Background job for
+cleaning the history table of all executed jobs
+
+=head1 SYNOPSIS
+
+This background job deletes old entries from the table
+C<background_job_histories>. Each time a job is run an entry is
+created in that table.
+
+The associated C<SL::DB::BackgroundJob> instance's C<data> may be a
+hash containing the retention periods for successful and failed
+jobs. Both are the number of days a history entry is to be kept.  C<<
+$data->{retention_success} >> defaults to 14.  C<<
+$data->{retention_failure} >> defaults to 90.
+
+The job is supposed to run once a day.
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/BackgroundJob/Test.pm b/SL/BackgroundJob/Test.pm
new file mode 100644
index 000000000..f79a1b586
--- /dev/null
+++ b/SL/BackgroundJob/Test.pm
@@ -0,0 +1,14 @@
+package SL::BackgroundJob::Test;
+
+use strict;
+
+use parent qw(SL::BackgroundJob::Base);
+
+sub run {
+  my $self   = shift;
+  my $db_obj = shift;
+
+  $::lxdebug->message(0, "Test job is being executed.");
+}
+
+1;
diff --git a/SL/DB.pm b/SL/DB.pm
index bcbf2e146..b48a49e70 100644
--- a/SL/DB.pm
+++ b/SL/DB.pm
@@ -21,14 +21,26 @@ sub create {
 
   my $db = __PACKAGE__->new_or_cached(domain => $domain, type => $type);
 
+  _execute_initial_sql($db);
+
   return $db;
 }
 
+my %_dateformats = ( 'yy-mm-dd'   => 'ISO',
+                     'yyyy-mm-dd' => 'ISO',
+                     'mm/dd/yy'   => 'SQL, US',
+                     'mm-dd-yy'   => 'POSTGRES, US',
+                     'dd/mm/yy'   => 'SQL, EUROPEAN',
+                     'dd-mm-yy'   => 'POSTGRES, EUROPEAN',
+                     'dd.mm.yy'   => 'GERMAN'
+                   );
+
 sub _register_db {
   my $domain = shift;
   my $type   = shift;
 
   my %connect_settings;
+  my $initial_sql;
 
   if (!%::myconfig) {
     $type = 'LXOFFICE_EMPTY';
@@ -44,6 +56,11 @@ sub _register_db {
                           connect_options => { pg_enable_utf8 => $::locale && $::locale->is_utf8,
                                              });
   } else {
+    my $european_dates = 0;
+    if ($::myconfig{dateformat}) {
+      $european_dates = 1 if $_dateformats{ $::myconfig{dateformat} } =~ m/european/i;
+    }
+
     %connect_settings = ( driver          => $::myconfig{dbdriver} || 'Pg',
                           database        => $::myconfig{dbname},
                           host            => $::myconfig{dbhost},
@@ -51,11 +68,14 @@ sub _register_db {
                           username        => $::myconfig{dbuser},
                           password        => $::myconfig{dbpasswd},
                           connect_options => { pg_enable_utf8 => $::locale && $::locale->is_utf8,
-                                             });
+                                             },
+                          european_dates  => $european_dates);
   }
 
+  my %flattened_settings = _flatten_settings(%connect_settings);
+
   $domain = 'LXOFFICE' if $type =~ m/^LXOFFICE/;
-  $type  .= join($SUBSCRIPT_SEPARATOR, map { $::connect_setings{$_} } sort keys %connect_settings);
+  $type  .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_}) } sort keys %flattened_settings);
   my $idx = "${domain}::${type}";
 
   if (!$_db_registered{$idx}) {
@@ -70,4 +90,32 @@ sub _register_db {
   return ($domain, $type);
 }
 
+sub _execute_initial_sql {
+  my ($db) = @_;
+
+  return if $_initial_sql_executed{$db} || !%::myconfig || !$::myconfig{dateformat};
+
+  $_initial_sql_executed{$db} = 1;
+
+  # Don't rely on dboptions being set properly. Chose them from
+  # dateformat instead.
+  my $pg_dateformat = $_dateformats{ $::myconfig{dateformat} };
+  $db->dbh->do("set DateStyle to '${pg_dateformat}'") if $pg_dateformat;
+}
+
+sub _flatten_settings {
+  my %settings  = @_;
+  my %flattened = ();
+
+  while (my ($key, $value) = each %settings) {
+    if ('HASH' eq ref $value) {
+      %flattened = ( %flattened, _flatten_settings(%{ $value }) );
+    } else {
+      $flattened{$key} = $value;
+    }
+  }
+
+  return %flattened;
+}
+
 1;
diff --git a/SL/DB/AccTrans.pm b/SL/DB/AccTrans.pm
deleted file mode 100644
index e058b8d53..000000000
--- a/SL/DB/AccTrans.pm
+++ /dev/null
@@ -1,13 +0,0 @@
-# This file has been auto-generated only because it didn't exist.
-# Feel free to modify it at will; it will not be overwritten automatically.
-
-package SL::DB::AccTrans;
-
-use strict;
-
-use SL::DB::MetaSetup::AccTrans;
-
-# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
-__PACKAGE__->meta->make_manager_class;
-
-1;
diff --git a/SL/DB/BackgroundJob.pm b/SL/DB/BackgroundJob.pm
new file mode 100644
index 000000000..253d0d380
--- /dev/null
+++ b/SL/DB/BackgroundJob.pm
@@ -0,0 +1,67 @@
+package SL::DB::BackgroundJob;
+
+use strict;
+
+use DateTime::Event::Cron;
+use English qw(-no_match_vars);
+
+use SL::DB::MetaSetup::BackgroundJob;
+use SL::DB::Manager::BackgroundJob;
+
+use SL::DB::BackgroundJobHistory;
+
+use SL::BackgroundJob::Test;
+
+sub update_next_run_at {
+  my $self = shift;
+
+  my $cron = DateTime::Event::Cron->new_from_cron($self->cron_spec || '* * * * *');
+  $self->update_attributes(next_run_at => $cron->next(DateTime->now_local));
+  return $self;
+}
+
+sub run {
+  my $self = shift;
+
+  my $package = "SL::BackgroundJob::" . $self->package_name;
+  my $run_at  = DateTime->now_local;
+  my $history;
+
+  my $ok = eval {
+    my $result = $package->new->run($self);
+
+    $history = SL::DB::BackgroundJobHistory
+      ->new(package_name => $self->package_name,
+            run_at       => $run_at,
+            status       => 'success',
+            result       => $result,
+            data         => $self->data);
+    $history->save;
+
+    1;
+  };
+
+  if (!$ok) {
+    $history = SL::DB::BackgroundJobHistory
+      ->new(package_name => $self->package_name,
+            run_at       => $run_at,
+            status       => 'failure',
+            error_col    => $EVAL_ERROR,
+            data         => $self->data);
+    $history->save;
+  }
+
+  $self->assign_attributes(last_run_at => $run_at)->update_next_run_at;
+
+  return $history;
+}
+
+sub data_as_hash {
+  my $self = shift;
+  return {}                        if !$self->data;
+  return $self->data               if ref($self->{data}) eq 'HASH';
+  return YAML::Load($self->{data}) if !ref($self->{data});
+  return {};
+}
+
+1;
diff --git a/SL/DB/BackgroundJobHistory.pm b/SL/DB/BackgroundJobHistory.pm
new file mode 100644
index 000000000..f8e08f8d9
--- /dev/null
+++ b/SL/DB/BackgroundJobHistory.pm
@@ -0,0 +1,13 @@
+# This file has been auto-generated only because it didn't exist.
+# Feel free to modify it at will; it will not be overwritten automatically.
+
+package SL::DB::BackgroundJobHistory;
+
+use strict;
+
+use SL::DB::MetaSetup::BackgroundJobHistory;
+
+# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
+__PACKAGE__->meta->make_manager_class;
+
+1;
diff --git a/SL/DB/Chart.pm b/SL/DB/Chart.pm
index 2d865b55d..bda45128c 100644
--- a/SL/DB/Chart.pm
+++ b/SL/DB/Chart.pm
@@ -3,7 +3,54 @@ package SL::DB::Chart;
 use strict;
 
 use SL::DB::MetaSetup::Chart;
+use SL::DB::Manager::Chart;
+use SL::DB::TaxKey;
 
-__PACKAGE__->meta->make_manager_class;
+__PACKAGE__->meta->add_relationships(taxkeys => { type         => 'one to many',
+                                                  class        => 'SL::DB::TaxKey',
+                                                  column_map   => { id => 'chart_id' },
+                                                },
+                                    );
+
+__PACKAGE__->meta->initialize;
+
+sub get_active_taxkey {
+  my ($self, $date) = @_;
+  $date ||= DateTime->today_local;
+  return SL::DB::Manager::TaxKey->get_all(where   => [ and => [ chart_id  => $self->id,
+                                                                startdate => { le => $date } ] ],
+                                          sort_by => "startdate DESC")->[0];
+}
 
 1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Chart - Rose database model for the "chart" table
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<get_active_taxkey $date>
+
+Returns the active tax key object for a given date. C<$date> defaults
+to the current date if undefined.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/Default.pm b/SL/DB/Default.pm
index 497ce3598..b71b0f474 100644
--- a/SL/DB/Default.pm
+++ b/SL/DB/Default.pm
@@ -1,6 +1,3 @@
-# This file has been auto-generated only because it didn't exist.
-# Feel free to modify it at will; it will not be overwritten automatically.
-
 package SL::DB::Default;
 
 use strict;
@@ -10,4 +7,16 @@ use SL::DB::MetaSetup::Default;
 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
 __PACKAGE__->meta->make_manager_class;
 
+sub get_default_currency {
+  my $self = shift->get;
+  my @currencies = grep { $_ } split(/:/, $self->curr || '');
+  return $currencies[0] || '';
+}
+
+sub get {
+  my ($class_or_self) = @_;
+  return $class_or_self if ref($class_or_self);
+  return SL::DB::Manager::Default->get_all(limit => 1)->[0];
+}
+
 1;
diff --git a/SL/DB/DeliveryOrder.pm b/SL/DB/DeliveryOrder.pm
index b5bdcb413..724a01d7b 100644
--- a/SL/DB/DeliveryOrder.pm
+++ b/SL/DB/DeliveryOrder.pm
@@ -4,6 +4,8 @@ use strict;
 
 use SL::DB::MetaSetup::DeliveryOrder;
 use SL::DB::Manager::DeliveryOrder;
+use SL::DB::Helper::LinkedRecords;
+use SL::DB::Helper::TransNumberGenerator;
 use SL::DB::Order;
 
 use List::Util qw(first);
@@ -19,6 +21,8 @@ __PACKAGE__->meta->initialize;
 
 # methods
 
+sub items { goto &orderitems; }
+
 sub sales_order {
   my $self   = shift;
   my %params = @_;
diff --git a/SL/DB/Helper/ALL.pm b/SL/DB/Helper/ALL.pm
index 50f4b3db7..f5973b3b7 100644
--- a/SL/DB/Helper/ALL.pm
+++ b/SL/DB/Helper/ALL.pm
@@ -2,10 +2,11 @@ package SL::DB::Helper::ALL;
 
 use strict;
 
-use SL::DB::AccTrans;
 use SL::DB::AccTransaction;
 use SL::DB::Assembly;
 use SL::DB::AuditTrail;
+use SL::DB::BackgroundJob;
+use SL::DB::BackgroundJobHistory;
 use SL::DB::BankAccount;
 use SL::DB::Bin;
 use SL::DB::Buchungsgruppe;
@@ -51,6 +52,8 @@ use SL::DB::Part;
 use SL::DB::PartsGroup;
 use SL::DB::PartsTax;
 use SL::DB::PaymentTerm;
+use SL::DB::PeriodicInvoice;
+use SL::DB::PeriodicInvoicesConfig;
 use SL::DB::PriceFactor;
 use SL::DB::Pricegroup;
 use SL::DB::Prices;
diff --git a/SL/DB/Helper/FlattenToForm.pm b/SL/DB/Helper/FlattenToForm.pm
new file mode 100644
index 000000000..9fc9b5c22
--- /dev/null
+++ b/SL/DB/Helper/FlattenToForm.pm
@@ -0,0 +1,107 @@
+package SL::DB::Helper::FlattenToForm;
+
+use strict;
+
+use parent qw(Exporter);
+our @EXPORT = qw(flatten_to_form);
+
+use List::MoreUtils qw(any);
+
+use SL::CVar;
+
+sub flatten_to_form {
+  my ($self, $form, %params) = @_;
+
+  my $vc = $self->can('customer_id') && $self->customer_id ? 'customer' : 'vendor';
+
+  _copy($self, $form, '', '', 0, qw(id type taxzone_id ordnumber quonumber invnumber donumber cusordnumber taxincluded shippingpoint shipvia notes intnotes curr cp_id
+                                    employee_id salesman_id closed department_id language_id payment_id delivery_customer_id delivery_vendor_id shipto_id proforma
+                                    globalproject_id delivered transaction_description container_type accepted_by_customer invoice terms storno storno_id dunning_config_id
+                                    orddate quodate reqdate gldate duedate deliverydate datepaid transdate));
+
+  if (_has($self, 'transdate')) {
+    my $transdate_idx = ref($self) eq 'SL::DB::Order'   ? ($self->quotation ? 'quodate' : 'orddate')
+                      : ref($self) eq 'SL::DB::Invoice' ? 'invdate'
+                      :                                   'transdate';
+    $form->{$transdate_idx} = $self->transdate->to_lxoffice;
+  }
+
+  $form->{vc} = $vc if ref($self) =~ /^SL::DB::.*Invoice/;
+
+  my @vc_fields          = (qw(account_number bank bank_code bic business city contact country creditlimit discount
+                               email fax homepage iban language name payment_terms phone street taxnumber zipcode),
+                            "${vc}number");
+  my @vc_prefixed_fields = qw(email fax notes number phone);
+
+  _copy($self,                          $form, '',              '', 1, qw(amount netamount marge_total marge_percent container_remaining_weight container_remaining_volume paid));
+  _copy($self->$vc,                     $form, '',              '', 0, @vc_fields);
+  _copy($self->$vc,                     $form, $vc,             '', 0, @vc_prefixed_fields);
+  _copy($self->contact,                 $form, '',              '', 0, grep { /^cp_/    } map { $_->name } SL::DB::Contact->meta->columns) if _has($self, 'cp_id');
+  _copy($self->shipto,                  $form, '',              '', 0, grep { /^shipto/ } map { $_->name } SL::DB::Shipto->meta->columns)  if _has($self, 'shipto_id');
+  _copy($self->globalproject,           $form, 'globalproject', '', 0, qw(number description))                                             if _has($self, 'globalproject_id');
+  _copy($self->employee,                $form, 'employee',      '', 0, map { $_->name } SL::DB::Employee->meta->columns)                   if _has($self, 'employee_id');
+  _copy($self->salesman,                $form, 'salesman',      '', 0, map { $_->name } SL::DB::Employee->meta->columns)                   if _has($self, 'salesman_id');
+  _copy($self->acceptance_confirmed_by, $form, 'acceptance_confirmed_by_', '', 0, map { $_->name } SL::DB::Employee->meta->columns)        if _has($self, 'acceptance_confirmed_by_id');
+
+  $form->{employee}   = $self->employee->name          if _has($self, 'employee_id');
+  $form->{language}   = $self->language->template_code if _has($self, 'language_id');
+  $form->{department} = $self->department->description if _has($self, 'department_id');
+  $form->{rowcount}   = scalar(@{ $self->items });
+
+  my $idx = 0;
+  my $format_amounts = $params{format_amounts};
+  foreach my $item (@{ $self->items }) {
+    next if _has($item, 'assemblyitem');
+
+    $idx++;
+
+    $form->{"id_${idx}"}     = $item->parts_id;
+    $form->{"number_${idx}"} = $item->part->partnumber;
+    _copy($item,          $form, '',         "_${idx}", 0,              qw(description project_id ship serialnumber pricegroup_id ordnumber cusordnumber unit
+                                                                           subtotal longdescription price_factor_id marge_price_factor approved_sellprice reqdate transdate));
+    _copy($item,          $form, '',        "_${idx}", $format_amounts, qw(qty sellprice discount marge_total marge_percent lastcost));
+    _copy($item->project, $form, 'project', "_${idx}", 0,               qw(number description)) if _has($item, 'project_id');
+
+    _copy_custom_variables($item, $form, 'ic_cvar_', "_${idx}");
+  }
+
+  _copy_custom_variables($self, $form, 'vc_cvar_', '');
+
+  return $self;
+}
+
+sub _has {
+  my ($obj, $column) = @_;
+  return $obj->can($column) && $obj->$column;
+}
+
+sub _copy {
+  my ($src, $form, $prefix, $postfix, $format_amounts, @columns) = @_;
+
+  map { $form->{"${prefix}${_}${postfix}"} = ref($src->$_) eq 'DateTime' ? $src->$_->to_lxoffice : $src->$_ if $src->can($_) } @columns if !$format_amounts;
+  map { $form->{"${prefix}${_}${postfix}"} = $::form->format_amount(\%::myconfig, $src->$_ * 1, 2) if $src->can($_)          } @columns if  $format_amounts;
+
+  return $src;
+}
+
+sub _copy_custom_variables {
+  my ($src, $form, $prefix, $postfix) = @_;
+
+  my ($module, $sub_module, $trans_id) = ref($src) eq 'SL::DB::OrderItem'         ? ('IC', 'orderitems',           $src->id)
+                                       : ref($src) eq 'SL::DB::DeliveryOrderItem' ? ('IC', 'delivery_order_items', $src->id)
+                                       : ref($src) eq 'SL::DB::InvoiceItem'       ? ('IC', 'invoice',              $src->id)
+                                       :                                            ('CT', undef,                  _has($src, 'customer_id') ? $src->customer_id : $src->vendor_id);
+
+  return unless $trans_id;
+
+  my $cvars = CVar->get_custom_variables(dbh        => $src->db->dbh,
+                                         module     => $module,
+                                         sub_module => $sub_module,
+                                         trans_id   => $trans_id,
+                                        );
+  map { $form->{ $prefix . $_->{name} . $postfix } = $_->{value} } @{ $cvars };
+
+  return $src;
+}
+
+1;
diff --git a/SL/DB/Helper/LinkedRecords.pm b/SL/DB/Helper/LinkedRecords.pm
new file mode 100644
index 000000000..6dad81f2e
--- /dev/null
+++ b/SL/DB/Helper/LinkedRecords.pm
@@ -0,0 +1,315 @@
+package SL::DB::Helper::LinkedRecords;
+
+use strict;
+
+require Exporter;
+our @ISA    = qw(Exporter);
+our @EXPORT = qw(linked_records link_to_record);
+
+use Carp;
+use Sort::Naturally;
+
+use SL::DB::Helper::Mappings;
+use SL::DB::RecordLink;
+
+sub linked_records {
+  my ($self, %params) = @_;
+
+  my %sort_spec       = ( by  => delete($params{sort_by}),
+                          dir => delete($params{sort_dir}) );
+  my $filter          =  delete $params{filter};
+
+  my $records         = linked_records_implementation($self, %params);
+  $records            = filter_linked_records($self, $filter, @{ $records })                       if $filter;
+  $records            = sort_linked_records($self, $sort_spec{by}, $sort_spec{dir}, @{ $records }) if $sort_spec{by};
+
+  return $records;
+}
+
+sub linked_records_implementation {
+  my $self     = shift;
+  my %params   = @_;
+
+  my $wanted   = $params{direction} || croak("Missing parameter `direction'");
+
+  if ($wanted eq 'both') {
+    my $both       = delete($params{both});
+    my %from_to    = ( from => delete($params{from}) || $both,
+                       to   => delete($params{to})   || $both);
+
+    my @records    = (@{ linked_records_implementation($self, %params, direction => 'from', from => $from_to{from}) },
+                      @{ linked_records_implementation($self, %params, direction => 'to',   to   => $from_to{to}  ) });
+
+    my %record_map = map { ( ref($_) . $_->id => $_ ) } @records;
+
+    return [ values %record_map ];
+  }
+
+  my $myself   = $wanted eq 'from' ? 'to' : $wanted eq 'to' ? 'from' : croak("Invalid parameter `direction'");
+
+  my $my_table = SL::DB::Helper::Mappings::get_table_for_package(ref($self));
+
+  my @query    = ( "${myself}_table" => $my_table,
+                   "${myself}_id"    => $self->id );
+
+  if ($params{$wanted}) {
+    my $wanted_classes = ref($params{$wanted}) eq 'ARRAY' ? $params{$wanted} : [ $params{$wanted} ];
+    my $wanted_tables  = [ map { SL::DB::Helper::Mappings::get_table_for_package($_) || croak("Invalid parameter `${wanted}'") } @{ $wanted_classes } ];
+    push @query, ("${wanted}_table" => $wanted_tables);
+  }
+
+  my $links            = SL::DB::Manager::RecordLink->get_all(query => [ and => \@query ]);
+
+  my $sub_wanted_table = "${wanted}_table";
+  my $sub_wanted_id    = "${wanted}_id";
+
+  my $records          = [];
+  @query               = ref($params{query}) eq 'ARRAY' ? @{ $params{query} } : ();
+
+  foreach my $link (@{ $links }) {
+    my $manager_class = SL::DB::Helper::Mappings::get_manager_package_for_table($link->$sub_wanted_table);
+    my $object_class  = SL::DB::Helper::Mappings::get_package_for_table($link->$sub_wanted_table);
+    eval "require " . $object_class . "; 1;";
+    push @{ $records }, @{ $manager_class->get_all(query => [ id => $link->$sub_wanted_id, @query ]) };
+  }
+
+  return $records;
+}
+
+sub link_to_record {
+  my $self   = shift;
+  my $other  = shift;
+  my %params = @_;
+
+  croak "self has no id"  unless $self->id;
+  croak "other has no id" unless $other->id;
+
+  my @directions = ([ 'from', 'to' ]);
+  push @directions, [ 'to', 'from' ] if $params{bidirectional};
+  my @links;
+
+  foreach my $direction (@directions) {
+    my %data = ( $direction->[0] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($self)),
+                 $direction->[0] . "_id"    => $self->id,
+                 $direction->[1] . "_table" => SL::DB::Helper::Mappings::get_table_for_package(ref($other)),
+                 $direction->[1] . "_id"    => $other->id,
+               );
+
+    my $link = SL::DB::Manager::RecordLink->find_by(and => [ %data ]);
+    push @links, $link ? $link : SL::DB::RecordLink->new(%data)->save unless $link;
+  }
+
+  return wantarray ? @links : $links[0];
+}
+
+sub sort_linked_records {
+  my ($self_or_class, $sort_by, $sort_dir, @records) = @_;
+
+  @records  = @{ $records[0] } if (1 == scalar(@records)) && (ref($records[0]) eq 'ARRAY');
+  $sort_dir = $sort_dir * 1 ? 1 : -1;
+
+  my %numbers = ( 'SL::DB::SalesProcess'    => sub { $_[0]->id },
+                  'SL::DB::Order'           => sub { $_[0]->quotation ? $_[0]->quonumber : $_[0]->ordnumber },
+                  'SL::DB::DeliveryOrder'   => sub { $_[0]->donumber },
+                  'SL::DB::Invoice'         => sub { $_[0]->invnumber },
+                  'SL::DB::PurchaseInvoice' => sub { $_[0]->invnumber },
+                  UNKNOWN                   => '9999999999999999',
+                );
+  my $number_xtor = sub {
+    my $number = $numbers{ ref($_[0]) };
+    $number    = $number->($_[0]) if ref($number) eq 'CODE';
+    return $number || $numbers{UNKNOWN};
+  };
+  my $number_comparator = sub {
+    my $number_a = $number_xtor->($a);
+    my $number_b = $number_xtor->($b);
+
+    ncmp($number_a, $number_b) * $sort_dir;
+  };
+
+  my %scores;
+  %scores = ( 'SL::DB::SalesProcess'    =>  10,
+              'SL::DB::Order'           =>  sub { $scores{ $_[0]->type } },
+              sales_quotation           =>  20,
+              sales_order               =>  30,
+              sales_delivery_order      =>  40,
+              'SL::DB::DeliveryOrder'   =>  sub { $scores{ $_[0]->type } },
+              'SL::DB::Invoice'         =>  50,
+              request_quotation         => 120,
+              purchase_order            => 130,
+              purchase_delivery_order   => 140,
+              'SL::DB::PurchaseInvoice' => 150,
+              UNKNOWN                   => 999,
+            );
+  my $score_xtor = sub {
+    my $score = $scores{ ref($_[0]) };
+    $score    = $score->($_[0]) if ref($score) eq 'CODE';
+    return $score || $scores{UNKNOWN};
+  };
+  my $type_comparator = sub {
+    my $score_a = $score_xtor->($a);
+    my $score_b = $score_xtor->($b);
+
+    $score_a == $score_b ? $number_comparator->() : ($score_a <=> $score_b) * $sort_dir;
+  };
+
+  my $today     = DateTime->today_local;
+  my $date_xtor = sub {
+      $_[0]->can('transdate_as_date') ? $_[0]->transdate_as_date
+    : $_[0]->can('itime_as_date')     ? $_[0]->itime_as_date
+    :                                   $today;
+  };
+  my $date_comparator = sub {
+    my $date_a = $date_xtor->($a);
+    my $date_b = $date_xtor->($b);
+
+    ($date_a <=> $date_b) * $sort_dir;
+  };
+
+  my $comparator = $sort_by eq 'number' ? $number_comparator
+                 : $sort_by eq 'date'   ? $date_comparator
+                 :                        $type_comparator;
+
+  return [ sort($comparator @records) ];
+}
+
+sub filter_linked_records {
+  my ($self_or_class, $filter, @records) = @_;
+
+  if ($filter eq 'accessible') {
+    my $employee = SL::DB::Manager::Employee->current;
+    @records     = grep { !$_->can('may_be_accessed') || $_->may_be_accessed($employee) } @records;
+  } else {
+    croak "Unsupported filter parameter '${filter}'";
+  }
+
+  return \@records;
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Helper::LinkedRecords - Mixin for retrieving linked records via the table C<record_links>
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<linked_records %params>
+
+Retrieves records linked from or to C<$self> via the table
+C<record_links>. The mandatory parameter C<direction> (either C<from>,
+C<to> or C<both>) determines whether the function retrieves records
+that link to C<$self> (for C<direction> = C<to>) or that are linked
+from C<$self> (for C<direction> = C<from>). For C<direction = both>
+all records linked from or to C<$self> are returned.
+
+The optional parameter C<from> or C<to> (same as C<direction>)
+contains the package names of Rose models for table limitation. It can
+be a single model name as a single scalar or multiple model names in
+an array reference in which case all links matching any of the model
+names will be returned.
+
+If you only need invoices created from an order C<$order> then the
+call could look like this:
+
+  my $invoices = $order->linked_records(direction => 'to',
+                                        to        => 'SL::DB::Invoice');
+
+The optional parameter C<query> can be used to limit the records
+returned. The following call limits the earlier example to invoices
+created today:
+
+  my $invoices = $order->linked_records(direction => 'to',
+                                        to        => 'SL::DB::Invoice',
+                                        query     => [ transdate => DateTime->today_local ]);
+
+The optional parameters C<$params{sort_by}> and C<$params{sort_dir}>
+can be used in order to sort the result. If C<$params{sort_by}> is
+trueish then the result is sorted by calling L</sort_linked_records>.
+
+The optional parameter C<$params{filter}> controls whether or not the
+result is filtered. Supported values are:
+
+=over 2
+
+=item C<accessible>
+
+Removes all objects for which the function C<may_be_accessed> from the
+mixin L<SL::DB::Helper::MayBeAccessed> exists and returns falsish for
+the current employee.
+
+=back
+
+Returns an array reference.
+
+=item C<link_to_record $record, %params>
+
+Will create an entry in the table C<record_links> with the C<from>
+side being C<$self> and the C<to> side being C<$record>. Will only
+insert a new entry if such a link does not already exist.
+
+If C<$params{bidirectional}> is trueish then another link will be
+created with the roles of C<from> and C<to> reversed. This link will
+also only be created if it doesn't exist already.
+
+In scalar contenxt returns either the existing link or the newly
+created one as an instance of C<SL::DB::RecordLink>. In array context
+it returns an array of links (one entry if C<$params{bidirectional}>
+is falsish and two entries if it is trueish).
+
+=item C<sort_linked_records $sort_by, $sort_dir, @records>
+
+Sorts linked records by C<$sort_by> in the direction given by
+C<$sort_dir> (trueish = ascending, falsish = descending). C<@records>
+can be either a single array reference or or normal array.
+
+C<$sort_by> can be one of the following strings:
+
+=over 2
+
+=item * C<type>
+
+Sort by type first and by record number second. The type order
+reflects the order in which records are usually processed by the
+employees: sales processes, sales quotations, sales orders, sales
+delivery orders, invoices; requests for quotation, purchase orders,
+purchase delivery orders, purchase invoices.
+
+=item * C<number>
+
+Sort by the record's running number.
+
+=item * C<date>
+
+Sort by the date the record was created or applies to.
+
+=back
+
+Returns a hash reference.
+
+Can be called both as a class or as an instance function.
+
+This function is not exported.
+
+=back
+
+=head1 EXPORTS
+
+This mixin exports the functions L</linked_records> and
+L</link_to_record>.
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/Helper/Mappings.pm b/SL/DB/Helper/Mappings.pm
index 48c486307..3ffd58561 100644
--- a/SL/DB/Helper/Mappings.pm
+++ b/SL/DB/Helper/Mappings.pm
@@ -1,4 +1,4 @@
-package SL::DB::Helpers::Mappings;
+package SL::DB::Helper::Mappings;
 
 use utf8;
 use strict;
@@ -24,6 +24,9 @@ my %lxoffice_package_names = (
   audittrail                     => 'audit_trail',
   ar                             => 'invoice',
   ap                             => 'purchase_invoice',
+  background_jobs                => 'background_job',
+  background_job_histories       => 'background_job_history',
+  ap                             => 'purchase_invoice',
   bank_accounts                  => 'bank_account',
   buchungsgruppen                => 'buchungsgruppe',
   contacts                       => 'contact',
@@ -63,6 +66,8 @@ my %lxoffice_package_names = (
   partsgroup                     => 'parts_group',
   partstax                       => 'parts_tax',
   payment_terms                  => 'payment_term',
+  periodic_invoices              => 'periodic_invoice',
+  periodic_invoices_configs      => 'periodic_invoices_config',
   prices                         => 'prices',
   price_factors                  => 'price_factor',
   pricegroup                     => 'pricegroup',
@@ -142,11 +147,11 @@ __END__
 
 =head1 NAME
 
-SL::DB::Helpers::Mappings - Rose Table <-> Model mapping information
+SL::DB::Helper::Mappings - Rose Table <-> Model mapping information
 
 =head1 SYNOPSIS
 
-  use SL::DB::Helpers::Mappings qw(@blacklist %table2model);
+  use SL::DB::Helper::Mappings qw(@blacklist %table2model);
 
 =head1 DESCRIPTION
 
diff --git a/SL/DB/Helper/PriceTaxCalculator.pm b/SL/DB/Helper/PriceTaxCalculator.pm
new file mode 100644
index 000000000..63dde450a
--- /dev/null
+++ b/SL/DB/Helper/PriceTaxCalculator.pm
@@ -0,0 +1,334 @@
+package SL::DB::Helper::PriceTaxCalculator;
+
+use strict;
+
+use parent qw(Exporter);
+our @EXPORT = qw(calculate_prices_and_taxes);
+
+use Carp;
+use List::Util qw(sum min);
+use SL::DB::Default;
+use SL::DB::PriceFactor;
+use SL::DB::Unit;
+
+sub calculate_prices_and_taxes {
+  my ($self, %params) = @_;
+
+  my %units_by_name       = map { ( $_->name => $_ ) } @{ SL::DB::Manager::Unit->get_all        };
+  my %price_factors_by_id = map { ( $_->id   => $_ ) } @{ SL::DB::Manager::PriceFactor->get_all };
+
+  my %data = ( lastcost_total      => 0,
+               invoicediff         => 0,
+               last_incex_chart_id => undef,
+               units_by_name       => \%units_by_name,
+               price_factors_by_id => \%price_factors_by_id,
+               taxes               => { },
+               amounts             => { },
+               amounts_cogs        => { },
+               allocated           => { },
+               assembly_items      => [ ],
+               exchangerate        => undef,
+               is_sales            => $self->can('customer') && $self->customer,
+               is_invoice          => (ref($self) =~ /Invoice/) || $params{invoice},
+             );
+
+  _get_exchangerate($self, \%data, %params);
+
+  $self->netamount(  0);
+  $self->marge_total(0);
+
+  my $idx = 0;
+  foreach my $item ($self->items) {
+    $idx++;
+    _calculate_item($self, $item, $idx, \%data, %params);
+  }
+
+  _calculate_amounts($self, \%data, %params);
+
+  return $self unless wantarray;
+
+  return map { ($_ => $data{$_}) } qw(taxes amounts amounts_cogs allocated exchangerate assembly_items);
+}
+
+sub _get_exchangerate {
+  my ($self, $data, %params) = @_;
+
+  if (($self->curr || '') ne SL::DB::Default->get_default_currency) {
+    $data->{exchangerate}   = $::form->check_exchangerate(\%::myconfig, $self->curr, $self->transdate, $data->{is_sales} ? 'buy' : 'sell');
+    $data->{exchangerate} ||= $params{exchangerate};
+  }
+  $data->{exchangerate} ||= 1;
+}
+
+sub _calculate_item {
+  my ($self, $item, $idx, $data, %params) = @_;
+
+  my $part_unit  = $data->{units_by_name}->{ $item->part->unit };
+  my $item_unit  = $data->{units_by_name}->{ $item->unit       };
+
+  croak("Undefined unit " . $item->part->unit) if !$part_unit;
+  croak("Undefined unit " . $item->unit)       if !$item_unit;
+
+  $item->base_qty($item_unit->convert_to($item->qty, $part_unit));
+  $item->fxsellprice($item->sellprice);
+
+  my $num_dec   = _num_decimal_places($item->sellprice);
+  my $discount  = _round($item->sellprice * ($item->discount || 0), $num_dec);
+  my $sellprice = _round($item->sellprice - $discount,              $num_dec);
+
+  $item->price_factor(      ! $item->price_factor_obj   ? 1 : ($item->price_factor_obj->factor   || 1));
+  $item->marge_price_factor(! $item->part->price_factor ? 1 : ($item->part->price_factor->factor || 1));
+  my $linetotal = _round($sellprice * $item->qty / $item->price_factor, 2) * $data->{exchangerate};
+  $linetotal    = _round($linetotal,                                    2);
+
+  $data->{invoicediff} += $sellprice * $item->qty * $data->{exchangerate} / $item->price_factor - $linetotal if $self->taxincluded;
+
+  if (!$linetotal) {
+    $item->marge_total(  0);
+    $item->marge_percent(0);
+
+  } else {
+    my $lastcost = ! ($item->lastcost * 1) ? ($item->part->lastcost || 0) : $item->lastcost;
+
+    $item->marge_total(  $linetotal - $lastcost / $item->marge_price_factor);
+    $item->marge_percent($item->marge_total * 100 / $linetotal);
+
+    $self->marge_total(  $self->marge_total + $item->marge_total);
+    $data->{lastcost_total} += $lastcost;
+  }
+
+  my $taxkey     = $item->part->get_taxkey(date => $self->transdate, is_sales => $data->{is_sales}, taxzone => $self->taxzone_id);
+  my $tax_rate   = $taxkey->tax->rate;
+  my $tax_amount = undef;
+
+  if ($self->taxincluded) {
+    $tax_amount = $linetotal * $tax_rate / ($tax_rate + 1);
+    $sellprice  = $sellprice             / ($tax_rate + 1);
+
+  } else {
+    $tax_amount = $linetotal * $tax_rate;
+  }
+
+  $data->{taxes}->{ $taxkey->tax->chart_id } ||= 0;
+  $data->{taxes}->{ $taxkey->tax->chart_id }  += $tax_amount;
+
+  $self->netamount($self->netamount + $sellprice * $item->qty / $item->price_factor);
+
+  my $chart = $item->part->get_chart(type => $data->{is_sales} ? 'income' : 'expense', taxzone => $self->taxzone_id);
+  $data->{amounts}->{ $chart->id }           ||= { taxkey => $taxkey->taxkey_id, amount => 0 };
+  $data->{amounts}->{ $chart->id }->{amount}  += $linetotal;
+
+  push @{ $data->{assembly_items} }, [];
+  if ($item->part->is_assembly) {
+    _calculate_assembly_item($self, $data, $item->part, $item->base_qty, $item->unit_obj->convert_to(1, $item->part->unit_obj));
+  } elsif ($item->part->is_part) {
+    $item->allocated(_calculate_part_item($self, $data, $item->part, $item->base_qty, $item->unit_obj->convert_to(1, $item->part->unit_obj)));
+  }
+
+  $data->{last_incex_chart_id} = $chart->id if $data->{is_sales};
+
+  _dbg("CALCULATE! ${idx} i.qty " . $item->qty . " i.sellprice " . $item->sellprice . " sellprice $sellprice num_dec $num_dec taxamount $tax_amount " .
+       "i.linetotal $linetotal netamount " . $self->netamount . " marge_total " . $item->marge_total . " marge_percent " . $item->marge_percent);
+}
+
+sub _calculate_amounts {
+  my ($self, $data, %params) = @_;
+
+  my $tax_diff = 0;
+  foreach my $chart_id (keys %{ $data->{taxes} }) {
+    my $rounded                  = _round($data->{taxes}->{$chart_id} * $data->{exchangerate}, 2);
+    $tax_diff                   += $data->{taxes}->{$chart_id} * $data->{exchangerate} - $rounded if $self->taxincluded;
+    $data->{taxes}->{$chart_id}  = $rounded;
+  }
+
+  my $amount    = _round(($self->netamount + $tax_diff) * $data->{exchangerate}, 2);
+  my $diff      = $amount - ($self->netamount + $tax_diff) * $data->{exchangerate};
+  my $netamount = $amount;
+
+  if ($self->taxincluded) {
+    $data->{invoicediff}                                         += $diff;
+    $data->{amounts}->{ $data->{last_incex_chart_id} }->{amount} += $data->{invoicediff} if $data->{last_incex_chart_id};
+  }
+
+  _dbg("Sna " . $self->netamount . " idiff " . $data->{invoicediff} . " tdiff ${tax_diff}");
+
+  my $tax              = sum values %{ $data->{taxes} };
+  $data->{arap_amount} = $netamount + $tax;
+
+  $self->netamount(    $netamount);
+  $self->amount(       $netamount + $tax);
+  $self->marge_percent($self->netamount ? ($self->netamount - $data->{lastcost_total}) * 100 / $self->netamount : 0);
+}
+
+sub _calculate_assembly_item {
+  my ($self, $data, $part, $total_qty, $base_factor) = @_;
+
+  return 0 if $::eur || !$data->{is_invoice};
+
+  foreach my $assembly_entry (@{ $part->assemblies }) {
+    push @{ $data->{assembly_items}->[-1] }, { part      => $assembly_entry->part,
+                                               qty       => $total_qty * $assembly_entry->qty,
+                                               allocated => 0 };
+
+    if ($assembly_entry->part->is_assembly) {
+      _calculate_assembly_item($self, $data, $assembly_entry->part, $total_qty * $assembly_entry->qty);
+    } elsif ($assembly_entry->part->is_part) {
+      my $allocated = _calculate_part_item($self, $data, $assembly_entry->part, $total_qty * $assembly_entry->qty);
+      $data->{assembly_items}->[-1]->[-1]->{allocated} = $allocated;
+    }
+  }
+}
+
+sub _calculate_part_item {
+  my ($self, $data, $part, $total_qty, $base_factor) = @_;
+
+  _dbg("cpsi tq " . $total_qty);
+
+  return 0 if $::eur || !$data->{is_invoice} || !$total_qty;
+
+  my ($entry);
+  $base_factor           ||= 1;
+  my $remaining_qty        = $total_qty;
+  my $expense_income_chart = $part->get_chart(type => $data->{is_sales} ? 'expense' : 'income', taxzone => $self->taxzone_id);
+  my $inventory_chart      = $part->get_chart(type => 'inventory',                              taxzone => $self->taxzone_id);
+
+  my $iterator             = SL::DB::Manager::InvoiceItem->get_all_iterator(query => [ and => [ parts_id => $part->id,
+                                                                                                \'(base_qty + allocated) < 0' ] ]);
+
+  while (($remaining_qty > 0) && ($entry = $iterator->next)) {
+    my $qty = min($remaining_qty, $entry->base_qty * -1 - $entry->allocated - $data->{allocated}->{ $entry->id });
+    _dbg("qty $qty");
+
+    next unless $qty;
+
+    my $linetotal = _round(($entry->sellprice * $qty) / $base_factor, 2);
+
+    $data->{amounts_cogs}->{ $expense_income_chart->id } -= $linetotal;
+    $data->{amounts_cogs}->{ $inventory_chart->id      } += $linetotal;
+
+    $data->{allocated}->{ $entry->id } ||= 0;
+    $data->{allocated}->{ $entry->id }  += $qty;
+    $remaining_qty                      -= $qty;
+  }
+
+  $iterator->finish;
+
+  return $remaining_qty - $total_qty;
+}
+
+sub _round {
+  return $::form->round_amount(@_);
+}
+
+sub _num_decimal_places {
+  return length( (split(/\./, '' . ($_[0] * 1), 2))[1] || '' );
+}
+
+sub _dbg {
+  $::lxdebug->message(0, join(' ', @_));
+}
+
+1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Helper::PriceTaxCalculator - Mixin for calculating the prices,
+amounts and taxes of orders, quotations, invoices
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<calculate_prices_and_taxes %params>
+
+Calculates the prices, amounts and taxes for an order, a quotation or
+an invoice.
+
+The function assumes that the mixing package has a certain layout and
+provides certain functions:
+
+=over 2
+
+=item C<transdate>
+
+The record's date.
+
+=item C<customer> or C<vendor>
+
+Determines if the record is a sales or purchase record.
+
+=item C<items>
+
+Accessor returning all line items for this record. The line items
+themselves must again have a certain layout. Instances of
+L<SL::DB::OrderItem> and L<SL::DB::InvoiceItem> are supported.
+
+=back
+
+The following values are calculated and set for C<$self>: C<amount>,
+C<netamount>, C<marge_percent>, C<marge_total>.
+
+The following values are calculated and set for each line item:
+C<base_qty>, C<price_factor>, C<marge_price_factor>, C<marge_total>,
+C<marge_percent>.
+
+The objects are not saved.
+
+Returns C<$self> in scalar context.
+
+In array context a hash with the following keys is returned:
+
+=over 2
+
+=item C<taxes>
+
+A hash reference with the calculated taxes. The keys are chart IDs,
+the values the calculated taxes.
+
+=item C<amounts>
+
+A hash reference with the calculated amounts. The keys are chart IDs,
+the values are hash references containing the two keys C<amount> and
+C<taxkey>.
+
+=item C<amounts_cogs>
+
+A hash reference with the calculated amounts for costs of goods
+sold. The keys are chart IDs, the values the calculated amounts.
+
+=item C<assembly_items>
+
+An array reference with as many entries as there are items in the
+record. Each entry is again an array reference of hash references with
+the keys C<part> (an instance of L<SL::DB::Part>), C<qty> and
+C<allocated>. Is only valid for invoices and can be used to populate
+the C<invoice> table with entries for assemblies.
+
+=item C<allocated>
+
+A hash reference. The keys are IDs of entries in the C<invoice>
+table. The values are the new values for the entry's C<allocated>
+column. Only valid for invoices.
+
+=item C<exchangerate>
+
+The exchangerate used for the calculation.
+
+=back
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/Helper/PriceUpdater.pm b/SL/DB/Helper/PriceUpdater.pm
new file mode 100644
index 000000000..a927f0e19
--- /dev/null
+++ b/SL/DB/Helper/PriceUpdater.pm
@@ -0,0 +1,111 @@
+package SL::DB::Helper::PriceUpdater;
+
+use strict;
+
+use parent qw(Exporter);
+our @EXPORT = qw(update_prices);
+
+use Carp;
+
+sub update_prices {
+  my $self   = shift;
+  my %params = @_;
+
+  croak('Missing parameters amount/percent') unless $params{amount} || $params{percent};
+
+  my @prices = ref $params{prices} eq 'ARRAY' ? @{ $params{prices} } : ( $params{prices} || 'sellprice' );
+
+  foreach my $field (@prices) {
+    my $rounding_error = 0;
+
+    foreach my $item (@{ $self->items }) {
+      my $new_price;
+      if ($params{amount}) {
+        $new_price = $item->$field + $params{amount}        + $rounding_error;
+      } else {
+        $new_price = $item->$field * $params{percent} / 100 + $rounding_error;
+      }
+
+      $item->$field($::form->round_amount($new_price, 2));
+      $rounding_error += $new_price - $item->$field;
+
+      _dbg("new_price $new_price new_price_no_err " . ($new_price - $rounding_error) . " rounded " . $item->$field .
+           " error_old " . ($rounding_error - $new_price + $item->$field) . " error_new $rounding_error");
+    }
+  }
+
+  return $self->calculate_prices_and_taxes if $params{calculate};
+  return $self;
+}
+
+sub _dbg {
+  # $::lxdebug->message(0, __PACKAGE__ . ': ' . join(' ', @_));
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Helper::PriceUpdater - Mixin for updating all prices by a fixed amount or by a percentage
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<update_prices %params>
+
+Updates the prices of all items as returned by the function C<items>
+provided by the mixing class.
+
+Supported arguments via C<%params> are:
+
+=over 2
+
+=item C<amount>
+
+Absolute amount to add or subtract. Either C<amount> or C<percent>
+must be given. Resulting prices are rounded to two significant places.
+
+=item C<percent>
+
+Percentage to set the prices to (with 100 meaning "no
+change"). Resulting prices are rounded to two significant
+places. Rounding errors are carried over to the next item.
+
+Either C<amount> or C<percent> must be given.
+
+=item C<prices>
+
+A string or an array of strings naming the prices to update. If
+missing only the C<sellprice> field will be updated.
+
+=item C<calculate>
+
+If trueish the all prices, taxes and amounts are re-calculated by
+calling
+L<SL::DB::Helper::PriceTaxCalculator::calculate_prices_and_taxes>.
+Returns that function's result.
+
+=back
+
+Returns C<$self> unless C<$params{calculate}> is trueish.
+
+=back
+
+=head1 EXPORTS
+
+This mixin exports the function L</update_prices>.
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/Helper/TransNumberGenerator.pm b/SL/DB/Helper/TransNumberGenerator.pm
new file mode 100644
index 000000000..c060a2f5d
--- /dev/null
+++ b/SL/DB/Helper/TransNumberGenerator.pm
@@ -0,0 +1,169 @@
+package SL::DB::Helper::TransNumberGenerator;
+
+use strict;
+
+use parent qw(Exporter);
+our @EXPORT = qw(get_next_trans_number create_trans_number);
+
+use Carp;
+use List::Util qw(max);
+
+use SL::DB::Default;
+
+my $oe_scoping = sub {
+  SL::DB::Manager::Order->type_filter($_[0]);
+};
+
+my $do_scoping = sub {
+  SL::DB::Manager::DeliveryOrder->type_filter($_[0]);
+};
+
+my %specs = ( ar                      => { number_column => 'invnumber',                                                             fill_holes_in_range => 1 },
+              sales_quotation         => { number_column => 'quonumber', number_range_column => 'sqnumber',  scoping => $oe_scoping,                          },
+              sales_order             => { number_column => 'ordnumber', number_range_column => 'sonumber',  scoping => $oe_scoping,                          },
+              request_quotation       => { number_column => 'quonumber', number_range_column => 'rfqnumber', scoping => $oe_scoping,                          },
+              purchase_order          => { number_column => 'ordnumber', number_range_column => 'ponumber',  scoping => $oe_scoping,                          },
+              sales_delivery_order    => { number_column => 'donumber',  number_range_column => 'sdonumber', scoping => $do_scoping, fill_holes_in_range => 1 },
+              purchase_delivery_order => { number_column => 'donumber',  number_range_column => 'pdonumber', scoping => $do_scoping, fill_holes_in_range => 1 },
+            );
+
+sub get_next_trans_number {
+  my ($self, %params) = @_;
+
+  my $spec_type           = $specs{ $self->meta->table } ? $self->meta->table : $self->type;
+  my $spec                = $specs{ $spec_type } || croak("Unsupported class " . ref($self));
+
+  my $number_column       = $spec->{number_column};
+  my $number              = $self->$number_column;
+  my $number_range_column = $spec->{number_range_column} || $number_column;
+  my $scoping_conditions  = $spec->{scoping};
+  my $fill_holes_in_range = $spec->{fill_holes_in_range};
+
+  return $number if $self->id && $number;
+
+  my $re              = '^(.*?)(\d+)$';
+  my %conditions      = $scoping_conditions ? ( query => [ $scoping_conditions->($spec_type) ] ) : ();
+  my @numbers         = map { $_->$number_column } @{ $self->_get_manager_class->get_all(%conditions) };
+  my %numbers_in_use  = map { ( $_ => 1 )        } @numbers;
+  @numbers            = grep { $_ } map { my @matches = m/$re/; @matches ? $matches[-1] * 1 : undef } @numbers;
+
+  my $defaults        = SL::DB::Default->get;
+  my $number_range    = $defaults->$number_range_column;
+  my @matches         = $number_range =~ m/$re/;
+  my $prefix          = (2 != scalar(@matches)) ? ''  : $matches[ 0];
+  my $ref_number      = !@matches               ? '1' : $matches[-1];
+  my $min_places      = length($ref_number);
+
+  my $new_number      = $fill_holes_in_range ? $ref_number : max($ref_number, @numbers);
+  my $new_number_full = undef;
+
+  while (1) {
+    $new_number      =  $new_number + 1;
+    my $new_number_s =  $new_number;
+    $new_number_s    =~ s/\.\d+//g;
+    $new_number_full =  $prefix . ('0' x max($min_places - length($new_number_s), 0)) . $new_number_s;
+    last if !$numbers_in_use{$new_number_full};
+  }
+
+  $defaults->update_attributes($number_range_column => $new_number_full) if $params{update_defaults};
+  $self->$number_column($new_number_full)                                if $params{update_record};
+
+  return $new_number_full;
+}
+
+sub create_trans_number {
+  my ($self, %params) = @_;
+
+  return $self->get_next_trans_number(update_defaults => 1, update_record => 1, %params);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Helper::TransNumberGenerator - A mixin for creating unique record numbers
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<get_mext_trams_number %params>
+
+Generates a new unique record number for the mixing class. Each record
+type (invoices, sales quotations, purchase orders etc) has its own
+number range. Within these ranges all numbers should be unique. The
+table C<defaults> contains the last record number assigned for all of
+the number ranges.
+
+This function contains hard-coded knowledge about the modules it can
+be mixed into. This way the models themselves don't have to contain
+boilerplate code for the details like the the number range column's
+name in the C<defaults> table.
+
+The process of creating a unique number involves the following steps:
+
+At first all existing record numbers for the current type are
+retrieved from the database as well as the last number assigned from
+the table C<defaults>.
+
+The next step is separating the number range from C<defaults> into two
+parts: an optional non-numeric prefix and its numeric suffix. The
+prefix, if present, will be kept intact.
+
+Now the number itself is increased as often as neccessary to create a
+unique one by comparing the generated numbers with the existing ones
+retrieved in the first step. In this step gaps in the assigned numbers
+are filled for some tables (e.g. invoices) but not for others
+(e.g. sales orders).
+
+After creating the unique record number this function can update
+C<$self> and the C<defaults> table if requested. This is controlled
+with the following parameters:
+
+=over 2
+
+=item * C<update_record>
+
+Determines whether or not C<$self>'s record number field is set to the
+newly generated number. C<$self> will not be saved even if this
+parameter is trueish. Defaults to false.
+
+=item * C<update_defaults>
+
+Determines whether or not the number range value in the C<defaults>
+table should be updated. Unlike C<$self> the C<defaults> table will be
+saved. Defaults to false.
+
+=back
+
+Always returns the newly generated number. This function cannot fail
+and return a value. If it fails then it is due to exceptions.
+
+=item C<create_trans_number %params>
+
+Calls and returns L</get_next_trans_number> with the parameters
+C<update_defaults = 1> and C<update_record = 1>. C<%params> is passed
+to it as well.
+
+=back
+
+=head1 EXPORTS
+
+This mixin exports all of its functions: L</get_next_trans_number> and
+L</create_trans_number>. There are no optional exports.
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/Invoice.pm b/SL/DB/Invoice.pm
index 993920c01..401d08865 100644
--- a/SL/DB/Invoice.pm
+++ b/SL/DB/Invoice.pm
@@ -5,10 +5,19 @@ package SL::DB::Invoice;
 
 use strict;
 
+use Carp;
 use List::Util qw(first);
 
 use SL::DB::MetaSetup::Invoice;
 use SL::DB::Manager::Invoice;
+use SL::DB::Helper::FlattenToForm;
+use SL::DB::Helper::LinkedRecords;
+use SL::DB::Helper::PriceTaxCalculator;
+use SL::DB::Helper::PriceUpdater;
+use SL::DB::Helper::TransNumberGenerator;
+use SL::DB::AccTransaction;
+use SL::DB::Chart;
+use SL::DB::Employee;
 
 __PACKAGE__->meta->add_relationship(
   invoiceitems => {
@@ -19,12 +28,19 @@ __PACKAGE__->meta->add_relationship(
       with_objects => [ 'part' ]
     }
   },
+  payment_term => {
+    type       => 'one to one',
+    class      => 'SL::DB::PaymentTerm',
+    column_map => { payment_id => 'id' },
+  },
 );
 
 __PACKAGE__->meta->initialize;
 
 # methods
 
+sub items { goto &invoiceitems; }
+
 # it is assumed, that ordnumbers are unique here.
 sub first_order_by_ordnumber {
   my $self = shift;
@@ -57,4 +73,229 @@ sub taxamount {
 
 __PACKAGE__->meta->make_attr_helpers(taxamount => 'numeric(15,5)');
 
+sub closed {
+  my ($self) = @_;
+  return $self->paid >= $self->amount;
+}
+
+sub new_from {
+  my ($class, $source, %params) = @_;
+
+  croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) =~ m/^ SL::DB:: (?: Order | DeliveryOrder ) $/x;
+  croak("Cannot create invoices for purchase records")           unless $source->customer_id;
+
+  my $terms = $source->can('payment_id') && $source->payment_id ? $source->payment_term->terms_netto : 0;
+
+  my %args = ( map({ ( $_ => $source->$_ ) } qw(customer_id taxincluded shippingpoint shipvia notes intnotes curr salesman_id cusordnumber ordnumber quonumber
+                                                department_id cp_id language_id payment_id delivery_customer_id delivery_vendor_id taxzone_id shipto_id
+                                                globalproject_id transaction_description)),
+               transdate   => DateTime->today_local,
+               gldate      => DateTime->today_local,
+               duedate     => DateTime->today_local->add(days => $terms * 1),
+               invoice     => 1,
+               type        => 'invoice',
+               storno      => 0,
+               paid        => 0,
+               employee_id => (SL::DB::Manager::Employee->current || SL::DB::Employee->new(id => $source->employee_id))->id,
+            );
+
+  if ($source->type =~ /_order$/) {
+    $args{deliverydate} = $source->reqdate;
+    $args{orddate}      = $source->transdate;
+  } else {
+    $args{quodate}      = $source->transdate;
+  }
+
+  my $invoice = $class->new(%args, %params);
+
+  my @items = map {
+    my $source_item = $_;
+    SL::DB::InvoiceItem->new(map({ ( $_ => $source_item->$_ ) }
+                                 qw(parts_id description qty sellprice discount project_id
+                                    serialnumber pricegroup_id ordnumber transdate cusordnumber unit
+                                    base_qty subtotal longdescription lastcost price_factor_id)),
+                            deliverydate => $source_item->reqdate,
+                            fxsellprice  => $source_item->sellprice,);
+  } @{ $source->items };
+
+  $invoice->invoiceitems(\@items);
+
+  return $invoice;
+}
+
+sub post {
+  my ($self, %params) = @_;
+
+  if (!$params{ar_id}) {
+    my $chart = SL::DB::Manager::Chart->get_all(query   => [ SL::DB::Manager::Chart->link_filter('AR') ],
+                                                sort_by => 'id ASC',
+                                                limit   => 1)->[0];
+    croak("No AR chart found and no parameter `ar_id' given") unless $chart;
+    $params{ar_id} = $chart->id;
+  }
+
+  my $worker = sub {
+    my %data = $self->calculate_prices_and_taxes;
+
+    $self->_post_create_assemblyitem_entries($data{assembly_items});
+    $self->create_trans_number;
+    $self->save;
+
+    $self->_post_add_acctrans($data{amounts_cogs});
+    $self->_post_add_acctrans($data{amounts});
+    $self->_post_add_acctrans($data{taxes});
+
+    $self->_post_add_acctrans({ $params{ar_id} => $self->amount * -1 });
+
+    $self->_post_update_allocated($data{allocated});
+  };
+
+  if ($self->db->in_transaction) {
+    $worker->();
+  } elsif (!$self->db->do_transaction($worker)) {
+    $::lxdebug->message(0, "convert_to_invoice failed: " . join("\n", (split(/\n/, $self->db->error))[0..2]));
+    return undef;
+  }
+
+  return $self;
+}
+
+sub _post_add_acctrans {
+  my ($self, $entries) = @_;
+
+  while (my ($chart_id, $spec) = each %{ $entries }) {
+    $spec = { taxkey => 0, amount => $spec } unless ref $spec;
+    SL::DB::AccTransaction->new(trans_id   => $self->id,
+                                chart_id   => $chart_id,
+                                amount     => $spec->{amount},
+                                taxkey     => $spec->{taxkey},
+                                project_id => $self->globalproject_id,
+                                transdate  => $self->transdate)->save;
+  }
+}
+
+sub _post_create_assemblyitem_entries {
+  my ($self, $assembly_entries) = @_;
+
+  my $items = $self->invoiceitems;
+  my @new_items;
+
+  my $item_idx = 0;
+  foreach my $item (@{ $items }) {
+    next if $item->assemblyitem;
+
+    push @new_items, $item;
+    $item_idx++;
+
+    foreach my $assembly_item (@{ $assembly_entries->[$item_idx] || [ ] }) {
+      push @new_items, SL::DB::InvoiceItem->new(parts_id     => $assembly_item->{part},
+                                                description  => $assembly_item->{part}->description,
+                                                unit         => $assembly_item->{part}->unit,
+                                                qty          => $assembly_item->{qty},
+                                                allocated    => $assembly_item->{allocated},
+                                                sellprice    => 0,
+                                                fxsellprice  => 0,
+                                                assemblyitem => 't');
+    }
+  }
+
+  $self->invoiceitems(\@new_items);
+}
+
+sub _post_update_allocated {
+  my ($self, $allocated) = @_;
+
+  while (my ($invoice_id, $diff) = each %{ $allocated }) {
+    SL::DB::Manager::InvoiceItem->update_all(set   => { allocated => { sql => "allocated + $diff" } },
+                                             where => [ id        => $invoice_id ]);
+  }
+}
+
 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+SL::DB::Invoice: Rose model for invoices (table "ar")
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<new_from $source>
+
+Creates a new C<SL::DB::Invoice> instance and copies as much
+information from C<$source> as possible. At the moment only sales
+orders and sales quotations are supported as sources.
+
+The conversion copies order items into invoice items. Dates are copied
+as appropriate, e.g. the C<transdate> field from an order will be
+copied into the invoice's C<orddate> field.
+
+Amounts, prices and taxes are not
+calculated. L<SL::DB::Helper::PriceTaxCalculator::calculate_prices_and_taxes>
+can be used for this.
+
+The object returned is not saved.
+
+=item C<post %params>
+
+Posts the invoice. Required parameters are:
+
+=over 2
+
+=item * C<ar_id>
+
+The ID of the accounds receivable chart the invoices amounts are
+posted to. If it is not set then the first chart configured for
+accounts receivables is used.
+
+=back
+
+This function implements several steps:
+
+=over 2
+
+=item 1. It calculates all prices, amounts and taxes by calling
+L<SL::DB::Helper::PriceTaxCalculator::calculate_prices_and_taxes>.
+
+=item 2. A new and unique invoice number is created.
+
+=item 3. All amounts for costs of goods sold are recorded in
+C<acc_trans>.
+
+=item 4. All amounts for parts, services and assemblies are recorded
+in C<acc_trans> with their respective charts. This is determined by
+the part's buchungsgruppen.
+
+=item 5. The total amount is posted to the accounts receivable chart
+and recorded in C<acc_trans>.
+
+=item 6. Items in C<invoice> are updated according to their allocation
+status (regarding for costs of goold sold). Will only be done if
+Lx-Office is not configured to use Einnahmenüberschussrechnungen
+(C<$::eur>).
+
+=item 7. The invoice and its items are saved.
+
+=back
+
+Returns C<$self> on success and C<undef> on failure. The whole process
+is run inside a transaction. If it fails then nothing is saved to or
+changed in the database. A new transaction is only started if none is
+active.
+
+=item C<basic_info $field>
+
+See L<SL::DB::Object::basic_info>.
+
+=back
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/InvoiceItem.pm b/SL/DB/InvoiceItem.pm
index d8b39034d..1407c3334 100644
--- a/SL/DB/InvoiceItem.pm
+++ b/SL/DB/InvoiceItem.pm
@@ -9,7 +9,17 @@ __PACKAGE__->meta->add_relationship(
     type         => 'one to one',
     class        => 'SL::DB::Part',
     column_map   => { parts_id => 'id' },
-  }
+  },
+  price_factor_obj => {
+    type           => 'one to one',
+    class          => 'SL::DB::PriceFactor',
+    column_map     => { price_factor_id => 'id' },
+  },
+  unit_obj       => {
+    type         => 'one to one',
+    class        => 'SL::DB::Unit',
+    column_map   => { unit => 'name' },
+  },
 );
 
 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
diff --git a/SL/DB/Manager/BackgroundJob.pm b/SL/DB/Manager/BackgroundJob.pm
new file mode 100644
index 000000000..1429a7856
--- /dev/null
+++ b/SL/DB/Manager/BackgroundJob.pm
@@ -0,0 +1,35 @@
+package SL::DB::Manager::BackgroundJob;
+
+use strict;
+
+use SL::DB::Helper::Manager;
+use base qw(SL::DB::Helper::Manager);
+
+sub object_class { 'SL::DB::BackgroundJob' }
+
+__PACKAGE__->make_manager_methods;
+
+sub cleanup {
+  my $class = shift;
+  $class->delete_all(where => [ and => [ type => 'once', last_run_at => { lt => DateTime->now_local->subtract(days => '1') } ] ]);
+}
+
+sub get_all_need_to_run {
+  my $class         = shift;
+
+  my $now           = DateTime->now_local;
+  my @interval_args = (and => [ type        => 'interval',
+                                active      => 1,
+                                next_run_at => { le => $now } ]);
+  my @once_args     = (and => [ type        => 'once',
+                                active      => 1,
+                                last_run_at => undef,
+                                or          => [ cron_spec   => undef,
+                                                 cron_spec   => '',
+                                                 next_run_at => undef,
+                                                 next_run_at => { le => $now } ] ]);
+
+  return $class->get_all(where => [ or => [ @interval_args, @once_args ] ]);
+}
+
+1;
diff --git a/SL/DB/Manager/Chart.pm b/SL/DB/Manager/Chart.pm
new file mode 100644
index 000000000..a0167fd23
--- /dev/null
+++ b/SL/DB/Manager/Chart.pm
@@ -0,0 +1,57 @@
+package SL::DB::Manager::Chart;
+
+use strict;
+
+use SL::DB::Helper::Manager;
+use base qw(SL::DB::Helper::Manager);
+
+use SL::DB::Helper::Sorted;
+
+sub object_class { 'SL::DB::Chart' }
+
+__PACKAGE__->make_manager_methods;
+
+sub link_filter {
+  my ($class, $link) = @_;
+
+  return (or => [ link => $link,
+                  link => { like => "${link}:\%"    },
+                  link => { like => "\%:${link}"    },
+                  link => { like => "\%:${link}:\%" } ]);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Manager::Chart - Manager class for the model for the C<chart> table
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<link_filter $link>
+
+Returns a query builder filter that matches charts whose 'C<link>'
+field contains C<$link>. Matching is done so that the exact value of
+C<$link> matches but not if C<$link> is only a substring of a
+match. Therefore C<$link = 'AR'> will match the column content 'C<AR>'
+or 'C<AR_paid:AR>' but not 'C<AR_amount>'.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/MetaSetup/AccTrans.pm b/SL/DB/MetaSetup/AccTrans.pm
deleted file mode 100644
index 8fcedbc15..000000000
--- a/SL/DB/MetaSetup/AccTrans.pm
+++ /dev/null
@@ -1,50 +0,0 @@
-# This file has been auto-generated. Do not modify it; it will be overwritten
-# by rose_auto_create_model.pl automatically.
-package SL::DB::AccTrans;
-
-use strict;
-
-use base qw(SL::DB::Object);
-
-__PACKAGE__->meta->setup(
-  table   => 'acc_trans',
-
-  columns => [
-    acc_trans_id   => { type => 'bigint', sequence => 'acc_trans_id_seq' },
-    trans_id       => { type => 'integer', not_null => 1 },
-    chart_id       => { type => 'integer', not_null => 1 },
-    amount         => { type => 'numeric', precision => 5, scale => 15 },
-    transdate      => { type => 'date', default => 'now' },
-    gldate         => { type => 'date', default => 'now' },
-    source         => { type => 'text' },
-    cleared        => { type => 'boolean', default => 'false' },
-    fx_transaction => { type => 'boolean', default => 'false' },
-    ob_transaction => { type => 'boolean', default => 'false' },
-    cb_transaction => { type => 'boolean', default => 'false' },
-    project_id     => { type => 'integer' },
-    memo           => { type => 'text' },
-    taxkey         => { type => 'integer' },
-    itime          => { type => 'timestamp', default => 'now()' },
-    mtime          => { type => 'timestamp' },
-    id             => { type => 'integer', not_null => 1, sequence => 'acc_trans_id_seq1' },
-  ],
-
-  primary_key_columns => [ 'id' ],
-
-  allow_inline_column_values => 1,
-
-  foreign_keys => [
-    chart => {
-      class       => 'SL::DB::Chart',
-      key_columns => { chart_id => 'id' },
-    },
-
-    project => {
-      class       => 'SL::DB::Project',
-      key_columns => { project_id => 'id' },
-    },
-  ],
-);
-
-1;
-;
diff --git a/SL/DB/MetaSetup/BackgroundJob.pm b/SL/DB/MetaSetup/BackgroundJob.pm
new file mode 100644
index 000000000..c3b8212c9
--- /dev/null
+++ b/SL/DB/MetaSetup/BackgroundJob.pm
@@ -0,0 +1,27 @@
+# This file has been auto-generated. Do not modify it; it will be overwritten
+# by rose_auto_create_model.pl automatically.
+package SL::DB::BackgroundJob;
+
+use strict;
+
+use base qw(SL::DB::Object);
+
+__PACKAGE__->meta->setup(
+  table   => 'background_jobs',
+
+  columns => [
+    id           => { type => 'serial', not_null => 1 },
+    type         => { type => 'varchar', length => 255 },
+    package_name => { type => 'varchar', length => 255 },
+    last_run_at  => { type => 'timestamp' },
+    next_run_at  => { type => 'timestamp' },
+    data         => { type => 'text' },
+    active       => { type => 'boolean' },
+    cron_spec    => { type => 'varchar', length => 255 },
+  ],
+
+  primary_key_columns => [ 'id' ],
+);
+
+1;
+;
diff --git a/SL/DB/MetaSetup/BackgroundJobHistory.pm b/SL/DB/MetaSetup/BackgroundJobHistory.pm
new file mode 100644
index 000000000..bd78a7d50
--- /dev/null
+++ b/SL/DB/MetaSetup/BackgroundJobHistory.pm
@@ -0,0 +1,26 @@
+# This file has been auto-generated. Do not modify it; it will be overwritten
+# by rose_auto_create_model.pl automatically.
+package SL::DB::BackgroundJobHistory;
+
+use strict;
+
+use base qw(SL::DB::Object);
+
+__PACKAGE__->meta->setup(
+  table   => 'background_job_histories',
+
+  columns => [
+    id           => { type => 'serial', not_null => 1 },
+    package_name => { type => 'varchar', length => 255 },
+    run_at       => { type => 'timestamp' },
+    status       => { type => 'varchar', length => 255 },
+    result       => { type => 'text' },
+    error        => { type => 'text', alias => 'error_col' },
+    data         => { type => 'text' },
+  ],
+
+  primary_key_columns => [ 'id' ],
+);
+
+1;
+;
diff --git a/SL/DB/MetaSetup/PeriodicInvoice.pm b/SL/DB/MetaSetup/PeriodicInvoice.pm
new file mode 100644
index 000000000..2a7abc992
--- /dev/null
+++ b/SL/DB/MetaSetup/PeriodicInvoice.pm
@@ -0,0 +1,38 @@
+# This file has been auto-generated. Do not modify it; it will be overwritten
+# by rose_auto_create_model.pl automatically.
+package SL::DB::PeriodicInvoice;
+
+use strict;
+
+use base qw(SL::DB::Object);
+
+__PACKAGE__->meta->setup(
+  table   => 'periodic_invoices',
+
+  columns => [
+    id                => { type => 'integer', not_null => 1, sequence => 'id' },
+    config_id         => { type => 'integer', not_null => 1 },
+    ar_id             => { type => 'integer', not_null => 1 },
+    period_start_date => { type => 'date', not_null => 1 },
+    itime             => { type => 'timestamp', default => 'now()' },
+  ],
+
+  primary_key_columns => [ 'id' ],
+
+  allow_inline_column_values => 1,
+
+  foreign_keys => [
+    ar => {
+      class       => 'SL::DB::Invoice',
+      key_columns => { ar_id => 'id' },
+    },
+
+    config => {
+      class       => 'SL::DB::PeriodicInvoicesConfig',
+      key_columns => { config_id => 'id' },
+    },
+  ],
+);
+
+1;
+;
diff --git a/SL/DB/MetaSetup/PeriodicInvoicesConfig.pm b/SL/DB/MetaSetup/PeriodicInvoicesConfig.pm
new file mode 100644
index 000000000..aeaf1c2ed
--- /dev/null
+++ b/SL/DB/MetaSetup/PeriodicInvoicesConfig.pm
@@ -0,0 +1,48 @@
+# This file has been auto-generated. Do not modify it; it will be overwritten
+# by rose_auto_create_model.pl automatically.
+package SL::DB::PeriodicInvoicesConfig;
+
+use strict;
+
+use base qw(SL::DB::Object);
+
+__PACKAGE__->meta->setup(
+  table   => 'periodic_invoices_configs',
+
+  columns => [
+    id                      => { type => 'integer', not_null => 1, sequence => 'id' },
+    oe_id                   => { type => 'integer', not_null => 1 },
+    periodicity             => { type => 'varchar', length => 10, not_null => 1 },
+    print                   => { type => 'boolean', default => 'false' },
+    printer_id              => { type => 'integer' },
+    copies                  => { type => 'integer' },
+    active                  => { type => 'boolean', default => 'true' },
+    start_date              => { type => 'date' },
+    ar_chart_id             => { type => 'integer', not_null => 1 },
+    terminated              => { type => 'boolean', default => 'false' },
+    end_date                => { type => 'date' },
+    extend_automatically_by => { type => 'integer' },
+  ],
+
+  primary_key_columns => [ 'id' ],
+
+  foreign_keys => [
+    ar_chart => {
+      class       => 'SL::DB::Chart',
+      key_columns => { ar_chart_id => 'id' },
+    },
+
+    oe => {
+      class       => 'SL::DB::Order',
+      key_columns => { oe_id => 'id' },
+    },
+
+    printer => {
+      class       => 'SL::DB::Printer',
+      key_columns => { printer_id => 'id' },
+    },
+  ],
+);
+
+1;
+;
diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index 0a698268c..9ac7644f9 100644
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -79,6 +79,12 @@ sub update_attributes {
   return $self;
 }
 
+sub call_sub {
+  my $self = shift;
+  my $sub  = shift;
+  return $self->$sub(@_);
+}
+
 1;
 
 __END__
@@ -132,6 +138,14 @@ Returns the manager package for the object or class that it is called
 on. Can be used from methods in this package for getting the actual
 object's manager.
 
+=item C<call_sub $name, @args>
+
+Calls the sub C<$name> on C<$self> with the arguments C<@args> and
+returns its result. This is meant for situations in which the sub's
+name is a composite, e.g.
+
+  my $chart_id = $buchungsgruppe->call_sub(($is_sales ? "income" : "expense") . "_accno_id_${taxzone_id}");
+
 =back
 
 =head1 AUTHOR
diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm
index 739581432..daab5dd7d 100644
--- a/SL/DB/Order.pm
+++ b/SL/DB/Order.pm
@@ -3,11 +3,19 @@ package SL::DB::Order;
 use utf8;
 use strict;
 
-use SL::RecordLinks;
+use Carp;
+use DateTime;
+use List::Util qw(max);
 
 use SL::DB::MetaSetup::Order;
 use SL::DB::Manager::Order;
 use SL::DB::Invoice;
+use SL::DB::Helper::FlattenToForm;
+use SL::DB::Helper::LinkedRecords;
+use SL::DB::Helper::PriceTaxCalculator;
+use SL::DB::Helper::PriceUpdater;
+use SL::DB::Helper::TransNumberGenerator;
+use SL::RecordLinks;
 
 __PACKAGE__->meta->add_relationship(
   orderitems => {
@@ -17,13 +25,30 @@ __PACKAGE__->meta->add_relationship(
     manager_args => {
       with_objects => [ 'part' ]
     }
-  }
+  },
+  periodic_invoices_config => {
+    type                   => 'one to one',
+    class                  => 'SL::DB::PeriodicInvoicesConfig',
+    column_map             => { id => 'oe_id' },
+  },
+  periodic_invoices        => {
+    type                   => 'one to many',
+    class                  => 'SL::DB::PeriodicInvoice',
+    column_map             => { id => 'oe_id' },
+  },
+  payment_term => {
+    type       => 'one to one',
+    class      => 'SL::DB::PaymentTerm',
+    column_map => { payment_id => 'id' },
+  },
 );
 
 __PACKAGE__->meta->initialize;
 
 # methods
 
+sub items { goto &orderitems; }
+
 sub type {
   my $self = shift;
 
@@ -63,6 +88,24 @@ sub end_invoice {
   return shift()->invoices(query => [ abschlag => 0 ]);
 }
 
+sub convert_to_invoice {
+  my ($self, %params) = @_;
+
+  croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
+
+  my $invoice;
+  if (!$self->db->do_transaction(sub {
+    $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
+    $self->link_to_record($invoice);
+    $self->update_attributes(closed => 1);
+    # die;
+  })) {
+    return undef;
+  }
+
+  return $invoice;
+}
+
 1;
 
 __END__
@@ -93,6 +136,33 @@ Returns one of the following string types:
 
 Rreturns true if the order is of the given type.
 
+=item C<convert_to_invoice %params>
+
+Creates a new invoice with C<$self> as the basis by calling
+L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
+linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
+C<closed> attribute is set to C<true>, and C<$self> is saved.
+
+The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
+
+Returns the new invoice instance on success and C<undef> on
+failure. The whole process is run inside a transaction. On failure
+nothing is created or changed in the database.
+
+At the moment only sales quotations and sales orders can be converted.
+
+=item C<create_sales_process>
+
+Creates and saves a new sales process. Can only be called for sales
+orders.
+
+The newly created process will be linked bidirectionally to both
+C<$self> and to all sales quotations that are linked to C<$self>.
+
+Returns the newly created process instance.
+
+=back
+
 =head1 BUGS
 
 Nothing here yet.
diff --git a/SL/DB/OrderItem.pm b/SL/DB/OrderItem.pm
index 94d2bc81d..1e17d364c 100644
--- a/SL/DB/OrderItem.pm
+++ b/SL/DB/OrderItem.pm
@@ -9,7 +9,17 @@ __PACKAGE__->meta->add_relationship(
     type         => 'one to one',
     class        => 'SL::DB::Part',
     column_map   => { parts_id => 'id' },
-  }
+  },
+  price_factor_obj => {
+    type           => 'one to one',
+    class          => 'SL::DB::PriceFactor',
+    column_map     => { price_factor_id => 'id' },
+  },
+  unit_obj       => {
+    type         => 'one to one',
+    class        => 'SL::DB::Unit',
+    column_map   => { unit => 'name' },
+  },
 );
 
 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
diff --git a/SL/DB/Part.pm b/SL/DB/Part.pm
index ce9738f32..8ec7b3b1b 100644
--- a/SL/DB/Part.pm
+++ b/SL/DB/Part.pm
@@ -3,9 +3,12 @@ package SL::DB::Part;
 use strict;
 
 use Carp;
+use List::MoreUtils qw(any);
+
 use SL::DBUtils;
 use SL::DB::MetaSetup::Part;
 use SL::DB::Manager::Part;
+use SL::DB::Chart;
 
 __PACKAGE__->meta->add_relationships(
   unit_obj                     => {
@@ -23,6 +26,11 @@ __PACKAGE__->meta->add_relationships(
     class        => 'SL::DB::PartsGroup',
     column_map   => { partsgroup_id => 'id' },
   },
+  price_factor   => {
+    type         => 'one to one',
+    class        => 'SL::DB::PriceFactor',
+    column_map   => { price_factor_id => 'id' },
+  },
 );
 
 __PACKAGE__->meta->initialize;
@@ -113,12 +121,59 @@ sub buchungsgruppe {
   shift->buchungsgruppen(@_);
 }
 
+sub get_taxkey {
+  my ($self, %params) = @_;
+
+  my $date     = $params{date} || DateTime->today_local;
+  my $is_sales = !!$params{is_sales};
+  my $taxzone  = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
+
+  $self->{__partpriv_taxkey_information} ||= { };
+  my $tk_info = $self->{__partpriv_taxkey_information};
+
+  $tk_info->{$taxzone}              ||= { };
+  $tk_info->{$taxzone}->{$is_sales} ||= { };
+
+  if (!exists $tk_info->{$taxzone}->{$is_sales}->{$date}) {
+    $tk_info->{$taxzone}->{$is_sales}->{$date} =
+      $self->get_chart(type => $is_sales ? 'income' : 'expense', taxzone => $taxzone)
+      ->load
+      ->get_active_taxkey($date);
+  }
+
+  return $tk_info->{$taxzone}->{$is_sales}->{$date};
+}
+
+sub get_chart {
+  my ($self, %params) = @_;
+
+  my $type    = (any { $_ eq $params{type} } qw(income expense inventory)) ? $params{type} : croak("Invalid 'type' parameter '$params{type}'");
+  my $taxzone = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
+
+  $self->{__partpriv_get_chart_id} ||= { };
+  my $charts = $self->{__partpriv_get_chart_id};
+
+  $charts->{$taxzone} ||= { };
+
+  if (!exists $charts->{$taxzone}->{$type}) {
+    my $bugru    = $self->buchungsgruppe;
+    my $chart_id = ($type eq 'inventory') ? ($self->inventory_accno_id ? $bugru->inventory_accno_id : undef)
+                 :                          $bugru->call_sub("${type}_accno_id_${taxzone}");
+
+    $charts->{$taxzone}->{$type} = $chart_id ? SL::DB::Chart->new(id => $chart_id)->load : undef;
+  }
+
+  return $charts->{$taxzone}->{$type};
+}
+
 1;
 
 __END__
 
 =pod
 
+=encoding utf-8
+
 =head1 NAME
 
 SL::DB::Part: Model for the 'parts' table
@@ -150,24 +205,30 @@ method for it, but you can construct them explicitly with C<new_part>,
 C<new_service>, and C<new_assembly>. A Buchungsgruppe should be supplied in this
 case, but it will use the default Buchungsgruppe if you don't.
 
-Matching these there are assorted helper methods dealing with type:
+Matching these there are assorted helper methods dealing with types,
+e.g.  L</new_part>, L</new_service>, L</new_assembly>, L</type>,
+L</is_type> and others.
 
-=head2 new_part PARAMS
+=head1 FUNCTIONS
+
+=over 4
 
-=head2 new_service PARAMS
+=item C<new_part %PARAMS>
 
-=head2 new_assembly PARAMS
+=item C<new_service %PARAMS>
+
+=item C<new_assembly %PARAMS>
 
 Will set the appropriate data fields so that the resulting instance will be of
 tthe requested type. Since part of the distinction are accounting targets,
 providing a C<Buchungsgruppe> is recommended. If none is given the constructor
 will load a default one and set the accounting targets from it.
 
-=head2 type
+=item C<type>
 
 Returns the type as a string. Can be one of C<part>, C<service>, C<assembly>.
 
-=head2 is_type TYPE
+=item C<is_type $TYPE>
 
 Tests if the current object is a part, a service or an
 assembly. C<$type> must be one of the words 'part', 'service' or
@@ -176,17 +237,15 @@ assembly. C<$type> must be one of the words 'part', 'service' or
 Returns 1 if the requested type matches, 0 if it doesn't and
 C<confess>es if an unknown C<$type> parameter is encountered.
 
-=head2 is_part
-
-=head2 is_service
+=item C<is_part>
 
-=head2 is_assembly
+=item C<is_service>
 
-Shorthand for is_type('part') etc.
+=item C<is_assembly>
 
-=head1 FUNCTIONS
+Shorthand for C<is_type('part')> etc.
 
-=head2 get_sellprice_info %params
+=item C<get_sellprice_info %params>
 
 Retrieves the C<sellprice> and C<price_factor_id> for a part under
 different conditions and returns a hash reference with those two keys.
@@ -200,24 +259,55 @@ entry without a country set will be used.
 If none of the above conditions is met then the information from
 C<$self> is used.
 
-=head2 get_ordered_qty %params
+=item C<get_ordered_qty %params>
 
 Retrieves the quantity that has been ordered from a vendor but that
 has not been delivered yet. Only open purchase orders are considered.
 
-=head2 orphaned
+=item C<get_taxkey %params>
+
+Retrieves and returns a taxkey object valid for the given date
+C<$params{date}> and tax zone C<$params{taxzone}>
+(C<$params{taxzone_id}> is also recognized). The date defaults to the
+current date if undefined.
+
+This function looks up the income (for trueish values of
+C<$params{is_sales}>) or expense (for falsish values of
+C<$params{is_sales}>) account for the current part. It uses the part's
+associated buchungsgruppe and uses the fields belonging to the tax
+zone given by C<$params{taxzone}> (range 0..3).
+
+The information retrieved by the function is cached.
+
+=item C<get_chart %params>
+
+Retrieves and returns a chart object valid for the given type
+C<$params{type}> and tax zone C<$params{taxzone}>
+(C<$params{taxzone_id}> is also recognized). The type must be one of
+the three key words C<income>, C<expense> and C<inventory>.
+
+This function uses the part's associated buchungsgruppe and uses the
+fields belonging to the tax zone given by C<$params{taxzone}> (range
+0..3).
+
+The information retrieved by the function is cached.
+
+=item C<orphaned>
 
 Checks if this articke is used in orders, invoices, delivery orders or
 assemblies.
 
-=head2 buchungsgruppe BUCHUNGSGRUPPE
+=item C<buchungsgruppe BUCHUNGSGRUPPE>
 
 Used to set the accounting informations from a L<SL:DB::Buchungsgruppe> object.
 Please note, that this is a write only accessor, the original Buchungsgruppe can
 not be retrieved from an article once set.
 
-=head1 AUTHOR
+=back
+
+=head1 AUTHORS
 
-Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 
 =cut
diff --git a/SL/DB/PeriodicInvoice.pm b/SL/DB/PeriodicInvoice.pm
new file mode 100644
index 000000000..37084ef32
--- /dev/null
+++ b/SL/DB/PeriodicInvoice.pm
@@ -0,0 +1,20 @@
+package SL::DB::PeriodicInvoice;
+
+use strict;
+
+use SL::DB::MetaSetup::PeriodicInvoice;
+
+__PACKAGE__->meta->add_relationships(
+  invoice      => {
+    type       => 'one to one',
+    class      => 'SL::DB::Invoice',
+    column_map => { ar_id => 'id' },
+  },
+);
+
+__PACKAGE__->meta->initialize;
+
+# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
+__PACKAGE__->meta->make_manager_class;
+
+1;
diff --git a/SL/DB/PeriodicInvoicesConfig.pm b/SL/DB/PeriodicInvoicesConfig.pm
new file mode 100644
index 000000000..3ed93bcf8
--- /dev/null
+++ b/SL/DB/PeriodicInvoicesConfig.pm
@@ -0,0 +1,20 @@
+package SL::DB::PeriodicInvoicesConfig;
+
+use strict;
+
+use SL::DB::MetaSetup::PeriodicInvoicesConfig;
+
+__PACKAGE__->meta->add_relationships(
+  order        => {
+    type       => 'one to one',
+    class      => 'SL::DB::Order',
+    column_map => { oe_id => 'id' },
+  },
+);
+
+__PACKAGE__->meta->initialize;
+
+# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
+__PACKAGE__->meta->make_manager_class;
+
+1;
diff --git a/SL/DB/PurchaseInvoice.pm b/SL/DB/PurchaseInvoice.pm
index a06a3b639..5123d681e 100644
--- a/SL/DB/PurchaseInvoice.pm
+++ b/SL/DB/PurchaseInvoice.pm
@@ -4,6 +4,9 @@ use strict;
 
 use SL::DB::MetaSetup::PurchaseInvoice;
 use SL::DB::Manager::PurchaseInvoice;
+use SL::DB::Helper::LinkedRecords;
+# The calculator hasn't been adjusted for purchase invoices yet.
+# use SL::DB::Helper::PriceTaxCalculator;
 
 __PACKAGE__->meta->add_relationship(invoiceitems => { type         => 'one to many',
                                                       class        => 'SL::DB::InvoiceItem',
@@ -14,4 +17,6 @@ __PACKAGE__->meta->add_relationship(invoiceitems => { type         => 'one to ma
 
 __PACKAGE__->meta->initialize;
 
+sub items { goto &invoiceitems; }
+
 1;
diff --git a/SL/DB/Tax.pm b/SL/DB/Tax.pm
index 58161aeff..017b5f13f 100644
--- a/SL/DB/Tax.pm
+++ b/SL/DB/Tax.pm
@@ -1,12 +1,17 @@
-# This file has been auto-generated only because it didn't exist.
-# Feel free to modify it at will; it will not be overwritten automatically.
-
 package SL::DB::Tax;
 
 use strict;
 
 use SL::DB::MetaSetup::Tax;
 
+__PACKAGE__->meta->add_relationships(chart => { type         => 'one to one',
+                                                class        => 'SL::DB::Chart',
+                                                column_map   => { chart_id => 'id' },
+                                              },
+                                    );
+
+__PACKAGE__->meta->initialize;
+
 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
 __PACKAGE__->meta->make_manager_class;
 
diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm
index 4a3f131d3..da7ffef64 100644
--- a/SL/Dispatcher.pm
+++ b/SL/Dispatcher.pm
@@ -9,11 +9,13 @@ BEGIN {
 }
 
 use CGI qw( -no_xhtml);
+use DateTime;
 use English qw(-no_match_vars);
 use SL::Auth;
 use SL::LXDebug;
 use SL::Locale;
 use SL::Common;
+use SL::Helper::DateTime;
 use Form;
 use List::Util qw(first);
 use File::Basename;
diff --git a/SL/Form.pm b/SL/Form.pm
index 8532c656f..e1646e69d 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -48,6 +48,7 @@ use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
 use SL::AM;
+use SL::DB;
 use SL::Common;
 use SL::DBUtils;
 use SL::Mailer;
@@ -1579,7 +1580,7 @@ sub get_standard_dbh {
     undef $standard_dbh;
   }
 
-  $standard_dbh ||= $self->dbconnect_noauto($myconfig);
+  $standard_dbh ||= SL::DB::create->dbh;
 
   $main::lxdebug->leave_sub(2);
 
diff --git a/SL/Helper/DateTime.pm b/SL/Helper/DateTime.pm
new file mode 100644
index 000000000..fa035ebfe
--- /dev/null
+++ b/SL/Helper/DateTime.pm
@@ -0,0 +1,57 @@
+package DateTime;
+
+sub now_local {
+  return shift->now(time_zone => $::locale->get_local_time_zone);
+}
+
+sub today_local {
+  return shift->now(time_zone => $::locale->get_local_time_zone)->truncate(to => 'day');
+}
+
+sub to_lxoffice {
+  return $::locale->format_date(\%::myconfig, $_[0]);
+}
+
+sub from_lxoffice {
+  return $::locale->parse_date_to_object(\%::myconfig, $_[1]);
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+SL::Helpers::DateTime - helper functions for L<DateTime>
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<now_local>
+
+Returns the current time with the time zone set to the local time zone.
+
+=item C<today_local>
+
+Returns the current date with the time zone set to the local time zone.
+
+=item C<to_lxoffice>
+
+Formats the date according to the current Lx-Office user's date
+format.
+
+=item C<from_lxoffice>
+
+Parses a date string formatted in the current Lx-Office user's date
+format and returns an instance of L<DateTime>.
+
+=back
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/Helper/Flash.pm b/SL/Helper/Flash.pm
index e599f6e6e..8f68d00c7 100644
--- a/SL/Helper/Flash.pm
+++ b/SL/Helper/Flash.pm
@@ -45,7 +45,7 @@ __END__
 
 =head1 NAME
 
-SL::Helpers::Flash - helper functions for storing messages to be
+SL::Helper::Flash - helper functions for storing messages to be
 displayed to the user
 
 =head1 SYNOPSIS
diff --git a/SL/Locale.pm b/SL/Locale.pm
index e9967396c..c45a1a1f1 100644
--- a/SL/Locale.pm
+++ b/SL/Locale.pm
@@ -497,4 +497,10 @@ sub restore_numberformat {
   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
 }
 
+sub get_local_time_zone {
+  my $self = shift;
+  $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
+  return $self->{local_time_zone};
+}
+
 1;
diff --git a/SL/OE.pm b/SL/OE.pm
index 677a78b39..7f0c8e363 100644
--- a/SL/OE.pm
+++ b/SL/OE.pm
@@ -35,9 +35,12 @@
 package OE;
 
 use List::Util qw(max first);
+use YAML;
+
 use SL::AM;
 use SL::Common;
 use SL::CVar;
+use SL::DB::PeriodicInvoicesConfig;
 use SL::DBUtils;
 use SL::IC;
 
@@ -58,11 +61,17 @@ sub transactions {
   my @values;
   my $where;
 
+  my ($periodic_invoices_columns, $periodic_invoices_joins);
+
   my $rate = ($form->{vc} eq 'customer') ? 'buy' : 'sell';
 
   if ($form->{type} =~ /_quotation$/) {
     $quotation = '1';
     $ordnumber = 'quonumber';
+
+  } elsif ($form->{type} eq 'sales_order') {
+    $periodic_invoices_columns = qq| , COALESCE(pcfg.active, 'f') AS periodic_invoices |;
+    $periodic_invoices_joins   = qq| LEFT JOIN periodic_invoices_configs pcfg ON (o.id = pcfg.oe_id) |;
   }
 
   my $vc = $form->{vc} eq "customer" ? "customer" : "vendor";
@@ -77,6 +86,7 @@ sub transactions {
     qq|  pr.projectnumber AS globalprojectnumber, | .
     qq|  e.name AS employee, s.name AS salesman, | .
     qq|  ct.${vc}number AS vcnumber, ct.country, ct.ustid  | .
+    $periodic_invoices_columns .
     qq|FROM oe o | .
     qq|JOIN $vc ct ON (o.${vc}_id = ct.id) | .
     qq|LEFT JOIN employee e ON (o.employee_id = e.id) | .
@@ -84,6 +94,7 @@ sub transactions {
     qq|LEFT JOIN exchangerate ex ON (ex.curr = o.curr | .
     qq|  AND ex.transdate = o.transdate) | .
     qq|LEFT JOIN project pr ON (o.globalproject_id = pr.id) | .
+    qq|$periodic_invoices_joins | .
     qq|WHERE (o.quotation = ?) |;
   push(@values, $quotation);
 
@@ -178,6 +189,11 @@ SQL
     push(@values, '%' . $form->{transaction_description} . '%');
   }
 
+  if ($form->{periodic_invoices_active} ne $form->{periodic_invoices_inactive}) {
+    my $not  = 'NOT' if ($form->{periodic_invoices_inactive});
+    $query  .= qq| AND ${not} COALESCE(pcfg.active, 'f')|;
+  }
+
   my $sortdir   = !defined $form->{sortdir} ? 'ASC' : $form->{sortdir} ? 'ASC' : 'DESC';
   my $sortorder = join(', ', map { "${_} ${sortdir} " } ("o.id", $form->sort_columns("transdate", $ordnumber, "name")));
   my %allowed_sort_columns = (
@@ -259,7 +275,7 @@ sub save {
   my ($self, $myconfig, $form) = @_;
 
   # connect to database, turn off autocommit
-  my $dbh = $form->dbconnect_noauto($myconfig);
+  my $dbh = $form->get_standard_dbh;
 
   my ($query, @values, $sth, $null);
   my $exchangerate = 0;
@@ -543,19 +559,53 @@ sub save {
     }
   }
 
+  $self->save_periodic_invoices_config(dbh         => $dbh,
+                                       oe_id       => $form->{id},
+                                       config_yaml => $form->{periodic_invoices_config})
+    if ($form->{type} eq 'sales_order');
+
   $form->{saved_xyznumber} = $form->{$form->{type} =~ /_quotation$/ ?
                                        "quonumber" : "ordnumber"};
 
   Common::webdav_folder($form) if ($main::webdav);
 
   my $rc = $dbh->commit;
-  $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
 
   return $rc;
 }
 
+sub save_periodic_invoices_config {
+  my ($self, %params) = @_;
+
+  return if !$params{oe_id};
+
+  my $config = $params{config_yaml} ? YAML::Load($params{config_yaml}) : undef;
+  return if 'HASH' ne ref $config;
+
+  my $obj  = SL::DB::Manager::PeriodicInvoicesConfig->find_by(oe_id => $params{oe_id})
+          || SL::DB::PeriodicInvoicesConfig->new(oe_id => $params{oe_id});
+  $obj->update_attributes(%{ $config });
+}
+
+sub load_periodic_invoice_config {
+  my $self = shift;
+  my $form = shift;
+
+  delete $form->{periodic_invoices_config};
+
+  if ($form->{id}) {
+    my $config_obj = SL::DB::Manager::PeriodicInvoicesConfig->find_by(oe_id => $form->{id});
+
+    if ($config_obj) {
+      my $config = { map { $_ => $config_obj->$_ } qw(active terminated periodicity start_date_as_date end_date_as_date extend_automatically_by ar_chart_id
+                                                      print printer_id copies) };
+      $form->{periodic_invoices_config} = YAML::Dump($config);
+    }
+  }
+}
+
 sub _close_quotations_rfqs {
   $main::lxdebug->enter_sub();
 
@@ -628,6 +678,10 @@ sub delete {
   # delete-values
   @values = (conv_i($form->{id}));
 
+  # periodic invoices and their configuration
+  do_query($form, $dbh, qq|DELETE FROM periodic_invoices         WHERE config_id IN (SELECT id FROM periodic_invoices_configs WHERE oe_id = ?)|, @values);
+  do_query($form, $dbh, qq|DELETE FROM periodic_invoices_configs WHERE oe_id = ?|, @values);
+
   # delete status entries
   $query = qq|DELETE FROM status | .
            qq|WHERE trans_id = ?|;
@@ -940,8 +994,9 @@ sub retrieve {
 
   Common::webdav_folder($form) if ($main::webdav);
 
+  $self->load_periodic_invoice_config($form);
+
   my $rc = $dbh->commit;
-  $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
 
diff --git a/bin/mozilla/oe.pl b/bin/mozilla/oe.pl
index b7d86538c..2f63157c9 100644
--- a/bin/mozilla/oe.pl
+++ b/bin/mozilla/oe.pl
@@ -41,6 +41,7 @@ use SL::IS;
 use SL::MoreCommon qw(ary_diff);
 use SL::PE;
 use SL::ReportGenerator;
+use List::MoreUtils qw(any none);
 use List::Util qw(max reduce sum);
 use Data::Dumper;
 
@@ -396,6 +397,16 @@ sub form_header {
   $onload .= qq|;setupPoints('|.   $myconfig{numberformat} .qq|', '|. $locale->text("wrongformat") .qq|')|;
   $TMPL_VAR{onload} = $onload;
 
+  if ($form->{type} eq 'sales_order') {
+    if (!$form->{periodic_invoices_config}) {
+      $form->{periodic_invoices_status} = $locale->text('not configured');
+
+    } else {
+      my $config                        = YAML::Load($form->{periodic_invoices_config});
+      $form->{periodic_invoices_status} = $config->{active} ? $locale->text('active') : $locale->text('inactive');
+    }
+  }
+
   $form->{javascript} .= qq|<script type="text/javascript" src="js/show_form_details.js"></script>|;
   $form->{javascript} .= qq|<script type="text/javascript" src="js/show_history.js"></script>|;
   $form->{javascript} .= qq|<script type="text/javascript" src="js/show_vc_details.js"></script>|;
@@ -747,7 +758,8 @@ sub orders {
     "salesman",
     "shipvia",                 "globalprojectnumber",
     "transaction_description", "open",
-    "delivered", "marge_total", "marge_percent",
+    "delivered",               "periodic_invoices",
+    "marge_total",             "marge_percent",
     "vcnumber",                "ustid",
     "country",
   );
@@ -758,8 +770,9 @@ sub orders {
     unshift @columns, "ids";
   }
 
-  $form->{l_open}      = $form->{l_closed} = "Y" if ($form->{open}      && $form->{closed});
-  $form->{l_delivered} = "Y"                     if ($form->{delivered} && $form->{notdelivered});
+  $form->{l_open}              = $form->{l_closed} = "Y" if ($form->{open}      && $form->{closed});
+  $form->{l_delivered}         = "Y"                     if ($form->{delivered} && $form->{notdelivered});
+  $form->{l_periodic_invoices} = "Y"                     if ($form->{periodic_invoices_active} && $form->{periodic_invoices_inactive});
 
   my $attachment_basename;
   if ($form->{vc} eq 'vendor') {
@@ -786,7 +799,7 @@ sub orders {
   my @hidden_variables = map { "l_${_}" } @columns;
   push @hidden_variables, "l_subtotal", $form->{vc}, qw(l_closed l_notdelivered open closed delivered notdelivered ordnumber quonumber
                                                         transaction_description transdatefrom transdateto type vc employee_id salesman_id
-                                                        reqdatefrom reqdateto projectnumber project_id);
+                                                        reqdatefrom reqdateto projectnumber project_id periodic_invoices_active periodic_invoices_inactive);
 
   my $href = build_std_url('action=orders', grep { $form->{$_} } @hidden_variables);
 
@@ -814,6 +827,7 @@ sub orders {
     'vcnumber'                => { 'text' => $form->{vc} eq 'customer' ? $locale->text('Customer Number') : $locale->text('Vendor Number'), },
     'country'                 => { 'text' => $locale->text('Country'), },
     'ustid'                   => { 'text' => $locale->text('USt-IdNr.'), },
+    'periodic_invoices'       => { 'text' => $locale->text('Per. Inv.'), },
   );
 
   foreach my $name (qw(id transdate reqdate quonumber ordnumber name employee salesman shipvia transaction_description)) {
@@ -855,6 +869,7 @@ sub orders {
   push @options, $locale->text('Closed')                                                                  if $form->{closed};
   push @options, $locale->text('Delivered')                                                               if $form->{delivered};
   push @options, $locale->text('Not delivered')                                                           if $form->{notdelivered};
+  push @options, $locale->text('Periodic invoices active')                                                if $form->{periodic_invoices_actibe};
 
   $report->set_options('top_info_text'        => join("\n", @options),
                        'raw_top_info_text'    => $form->parse_html_template('oe/orders_top'),
@@ -884,9 +899,10 @@ sub orders {
   foreach my $oe (@{ $form->{OE} }) {
     map { $oe->{$_} *= $oe->{exchangerate} } @subtotal_columns;
 
-    $oe->{tax}       = $oe->{amount} - $oe->{netamount};
-    $oe->{open}      = $oe->{closed}    ? $locale->text('No')  : $locale->text('Yes');
-    $oe->{delivered} = $oe->{delivered} ? $locale->text('Yes') : $locale->text('No');
+    $oe->{tax}               = $oe->{amount} - $oe->{netamount};
+    $oe->{open}              = $oe->{closed}            ? $locale->text('No')  : $locale->text('Yes');
+    $oe->{delivered}         = $oe->{delivered}         ? $locale->text('Yes') : $locale->text('No');
+    $oe->{periodic_invoices} = $oe->{periodic_invoices} ? $locale->text('On')  : $locale->text('Off');
 
     map { $subtotals{$_} += $oe->{$_};
           $totals{$_}    += $oe->{$_} } @subtotal_columns;
@@ -1936,6 +1952,69 @@ sub report_for_todo_list {
   return $content;
 }
 
+sub edit_periodic_invoices_config {
+  $::lxdebug->enter_sub();
+
+  $::form->{type} = 'sales_order';
+
+  check_oe_access();
+
+  my $config;
+  $config = YAML::Load($::form->{periodic_invoices_config}) if $::form->{periodic_invoices_config};
+
+  if ('HASH' ne ref $config) {
+    $config =  { periodicity             => 'y',
+                 start_date_as_date      => $::form->{transdate},
+                 extend_automatically_by => 12,
+                 active                  => 1,
+               };
+  }
+
+  $config->{periodicity} = 'm' if none { $_ eq $config->{periodicity} } qw(m q y);
+
+  $::form->get_lists(printers => "ALL_PRINTERS",
+                     charts   => { key       => 'ALL_CHARTS',
+                                   transdate => 'current_date' });
+
+  $::form->{AR}    = [ grep { $_->{link} =~ m/(?:^|:)AR(?::|$)/ } @{ $::form->{ALL_CHARTS} } ];
+  $::form->{title} = $::locale->text('Edit the configuration for periodic invoices');
+
+  $::form->header();
+  print $::form->parse_html_template('oe/edit_periodic_invoices_config', $config);
+
+  $::lxdebug->leave_sub();
+}
+
+sub save_periodic_invoices_config {
+  $::lxdebug->enter_sub();
+
+  $::form->{type} = 'sales_order';
+
+  check_oe_access();
+
+  $::form->isblank('start_date_as_date', $::locale->text('The start date is missing.'));
+
+  my $config = { active                  => $::form->{active}     ? 1 : 0,
+                 terminated              => $::form->{terminated} ? 1 : 0,
+                 periodicity             => (any { $_ eq $::form->{periodicity} } qw(m q y)) ? $::form->{periodicity} : 'm',
+                 start_date_as_date      => $::form->{start_date_as_date},
+                 end_date_as_date        => $::form->{end_date_as_date},
+                 print                   => $::form->{print} ? 1 : 0,
+                 printer_id              => $::form->{print} ? $::form->{printer_id} * 1 : undef,
+                 copies                  => $::form->{copies} * 1 ? $::form->{copies} : 1,
+                 extend_automatically_by => $::form->{extend_automatically_by} * 1 || undef,
+                 ar_chart_id             => $::form->{ar_chart_id} * 1,
+               };
+
+  $::form->{periodic_invoices_config} = YAML::Dump($config);
+
+  $::form->{title} = $::locale->text('Edit the configuration for periodic invoices');
+  $::form->header;
+  print $::form->parse_html_template('oe/save_periodic_invoices_config', $config);
+
+  $::lxdebug->leave_sub();
+}
+
 sub dispatcher {
   my $form     = $main::form;
   my $locale   = $main::locale;
diff --git a/config/periodic_invoices.conf.default b/config/periodic_invoices.conf.default
new file mode 100644
index 000000000..facc21c1e
--- /dev/null
+++ b/config/periodic_invoices.conf.default
@@ -0,0 +1,5 @@
+[periodic_invoices]
+send_email     = 1
+email_from     = Lx-Office Daemon <root@localhost>
+email_subject  = Benachrichtigung: automatisch erstellte Rechnungen
+email_template = templates/webpages/oe/periodic_invoices_email.txt
diff --git a/config/task_server.conf.default b/config/task_server.conf.default
new file mode 100644
index 000000000..d72e63d29
--- /dev/null
+++ b/config/task_server.conf.default
@@ -0,0 +1,7 @@
+[task_server]
+# User name to use for database access
+login =
+# Set to 1 for debug messages in /tmp/lx-office-debug.log
+debug = 0
+# Chose a system user the daemon should run under when started as root.
+run_as = www
diff --git a/js/edit_periodic_invoices_config.js b/js/edit_periodic_invoices_config.js
new file mode 100644
index 000000000..7899f3d9b
--- /dev/null
+++ b/js/edit_periodic_invoices_config.js
@@ -0,0 +1,16 @@
+function edit_periodic_invoices_config() {
+  var width     = 750;
+  var height    = 550;
+  var parm      = centerParms(width, height) + ",width=" + width + ",height=" + height + ",status=yes,scrollbars=yes";
+
+  var config    = $('#periodic_invoices_config').attr('value');
+  var transdate = $('#transdate').attr('value');
+
+  var url       = "oe.pl?" +
+    "action=edit_periodic_invoices_config&" +
+    "periodic_invoices_config=" + encodeURIComponent(config) + "&" +
+    "transdate="                + encodeURIComponent(transdate);
+
+  // alert(url);
+  window.open(url, "_new_generic", parm);
+}
diff --git a/locale/de/all b/locale/de/all
index f00c0307f..115222d37 100644
--- a/locale/de/all
+++ b/locale/de/all
@@ -382,6 +382,7 @@ $self->{texts} = {
   'Company Name'                => 'Firmenname',
   'Compare to'                  => 'Gegenüberstellen zu',
   'Configuration of individual TODO items' => 'Konfiguration f&uuml;r die einzelnen Aufgabenlistenpunkte',
+  'Configure'                   => 'Konfigurieren',
   'Confirm'                     => 'Best&auml;tigen',
   'Confirm!'                    => 'Bestätigen Sie!',
   'Confirmation'                => 'Auftragsbestätigung',
@@ -675,6 +676,7 @@ $self->{texts} = {
   'Edit rights'                 => 'Rechte bearbeiten',
   'Edit templates'              => 'Vorlagen bearbeiten',
   'Edit the Delivery Order'     => 'Lieferschein bearbeiten',
+  'Edit the configuration for periodic invoices' => 'Konfiguration für wiederkehrende Rechnungen bearbeiten',
   'Edit the membership of all users in all groups:' => 'Bearbeiten der Mitgliedschaft aller Benutzer in allen Gruppen:',
   'Edit the purchase_order'     => 'Bearbeiten des Lieferantenauftrags',
   'Edit the request_quotation'  => 'Bearbeiten der Preisanfrage',
@@ -687,6 +689,7 @@ $self->{texts} = {
   'Element disabled'            => 'Element deaktiviert',
   'Employee'                    => 'Bearbeiter',
   'Empty transaction!'          => 'Buchung ist leer!',
+  'End date'                    => 'Enddatum',
   'Enter a description for this new draft.' => 'Geben Sie eine Beschreibung f&uuml;r diesen Entwurf ein.',
   'Enter longdescription'       => 'Langtext eingeben',
   'Enter the requested execution date or leave empty for the quickest possible execution:' => 'Geben Sie das jeweils gewünschte Ausführungsdatum an, oder lassen Sie das Feld leer für die schnellstmögliche Ausführung:',
@@ -733,6 +736,7 @@ $self->{texts} = {
   'Export date'                 => 'Exportdatum',
   'Export date from'            => 'Exportdatum von',
   'Export date to'              => 'Exportdatum bis',
+  'Extend automatically by n months' => 'Automatische Verlängerung um x Monate',
   'Extended'                    => 'Gesamt',
   'Extension Of Time'           => 'Dauerfristverlängerung',
   'Factor'                      => 'Faktor',
@@ -1198,8 +1202,13 @@ $self->{texts} = {
   'Payment posted!'             => 'Zahlung gebucht!',
   'Payment terms deleted!'      => 'Zahlungskonditionen gelöscht!',
   'Payments'                    => 'Zahlungsausgänge',
+  'Per. Inv.'                   => 'Wied. Rech.',
   'Period'                      => 'Zeitraum',
   'Period:'                     => 'Zeitraum:',
+  'Periodic Invoices'           => 'Wiederkehrende Rechnungen',
+  'Periodic invoices active'    => 'Wiederkehrende Rechnungen aktiv',
+  'Periodic invoices inactive'  => 'Wiederkehrende Rechnungen inaktiv',
+  'Periodicity'                 => 'Periodizität',
   'Personal settings'           => 'Pers&ouml;nliche Einstellungen',
   'Pg Database Administration'  => 'Datenbankadministration',
   'Phone'                       => 'Telefon',
@@ -1265,6 +1274,7 @@ $self->{texts} = {
   'Pricegroups'                 => 'Preisgruppen',
   'Print'                       => 'Drucken',
   'Print and Post'              => 'Drucken und Buchen',
+  'Print automatically'         => 'Automatisch ausdrucken',
   'Print dunnings'              => 'Mahnungen drucken',
   'Print list'                  => 'Liste ausdrucken',
   'Print options'               => 'Druckoptionen',
@@ -1500,6 +1510,7 @@ $self->{texts} = {
   'Spoolfile'                   => 'Druckdatei',
   'Start Dunning Process'       => 'Mahnprozess starten',
   'Start analysis'              => 'Analyse beginnen',
+  'Start date'                  => 'Startdatum',
   'Start the correction assistant' => 'Korrekturassistenten starten',
   'Startdate_coa'               => 'Gültig ab',
   'Starting Balance'            => 'Eröffnungsbilanzwerte',
@@ -1507,6 +1518,7 @@ $self->{texts} = {
   'Statement Balance'           => 'Sammelrechnungsbilanz',
   'Statement sent to'           => 'Sammelrechnung verschickt an',
   'Statements sent to printer!' => 'Sammelrechnungen an Drucker geschickt!',
+  'Status'                      => 'Status',
   'Step 1 of 3: Parts'          => 'Schritt 1 von 3: Waren',
   'Step 2'                      => 'Schritt 2',
   'Step 2 of 3: Services'       => 'Schritt 2 von 3: Dienstleistungen',
@@ -1632,6 +1644,7 @@ $self->{texts} = {
   'The dunning process started' => 'Der Mahnprozess ist gestartet.',
   'The dunnings have been printed.' => 'Die Mahnung(en) wurden gedruckt.',
   'The email address is missing.' => 'Die Emailadresse fehlt.',
+  'The end date is the last day for which invoices will possibly be created.' => 'Das Enddatum ist das letztmögliche Datum, an dem eine Rechnung erzeugt wird.',
   'The factor is missing in row %d.' => 'Der Faktor fehlt in Zeile %d.',
   'The factor is missing.'      => 'Der Faktor fehlt.',
   'The first reason is that Lx-Office contained a bug which resulted in the wrong taxkeys being recorded for transactions in which two entries are posted for the same chart with different taxkeys.' => 'Zum Einen gab es einen Bug in Lx-Office, der dazu führte, dass bei Buchungen mit verschiedenen Steuerschlüssel auf ein Konto teilweise falsche Steuerschlüssel gespeichert wurden.',
@@ -1685,6 +1698,7 @@ $self->{texts} = {
   'The selected warehouse is empty.' => 'Das ausgew&auml;hlte Lager ist leer.',
   'The session is invalid or has expired.' => 'Sie sind von Lx-Office abgemeldet.',
   'The source warehouse does not contain any bins.' => 'Das Quelllager enth&auml;lt keine Lagerpl&auml;tze.',
+  'The start date is missing.'  => 'Das Startdatum fehlt.',
   'The subject is missing.'     => 'Der Betreff fehlt.',
   'The tables for user management and authentication do not exist. They will be created in the next step in the following database:' => 'Die Tabellen zum Speichern der Benutzerdaten und zur Benutzerauthentifizierung wurden nicht gefunden. Sie werden in der folgenden Datenbank angelegt:',
   'The tabulator character'     => 'Das Tabulator-Symbol',
@@ -1945,6 +1959,7 @@ $self->{texts} = {
   '[email]'                     => '[email]',
   'account_description'         => 'Beschreibung',
   'accrual'                     => 'Bilanzierung (Soll-Versteuerung)',
+  'active'                      => 'aktiv',
   'all entries'                 => 'alle Einträge',
   'ap_aging_list'               => 'liste_offene_verbindlichkeiten',
   'ar_aging_list'               => 'liste_offene_forderungen',
@@ -1999,6 +2014,7 @@ $self->{texts} = {
   'general_ledger_list'         => 'buchungsjournal',
   'history'                     => 'Historie',
   'history search engine'       => 'Historien Suchmaschine',
+  'inactive'                    => 'inaktiv',
   'invoice'                     => 'Rechnung',
   'invoice_list'                => 'debitorenbuchungsliste',
   'lead deleted!'               => 'Kundenquelle gelöscht',
@@ -2012,11 +2028,13 @@ $self->{texts} = {
   'mark as paid'                => 'als bezahlt markieren',
   'missing'                     => 'Fehlbestand',
   'month'                       => 'Monatliche Abgabe',
+  'monthly'                     => 'monatlich',
   'new Window'                  => 'neues Fenster',
   'no'                          => 'nein',
   'no bestbefore'               => 'keine Mindesthaltbarkeit',
   'no chargenumber'             => 'keine Chargennummer',
   'none (pricegroup)'           => 'keine',
+  'not configured'              => 'nicht konfiguriert',
   'not executed'                => 'nicht ausgeführt',
   'not transferred in yet'      => 'noch nicht eingelagert',
   'not transferred out yet'     => 'noch nicht ausgelagert',
@@ -2041,6 +2059,7 @@ $self->{texts} = {
   'purchase_order'              => 'Auftrag',
   'purchase_order_list'         => 'lieferantenauftragsliste',
   'quarter'                     => 'Vierteljährliche (quartalsweise) Abgabe',
+  'quarterly'                   => 'quartalsweise',
   'quotation_list'              => 'angebotsliste',
   'release_material'            => 'Materialausgabebe',
   'report_generator_dispatch_to is not defined.' => 'report_generator_dispatch_to ist nicht definiert.',
@@ -2070,6 +2089,7 @@ $self->{texts} = {
   'tax_taxdescription'          => 'Steuername',
   'tax_taxkey'                  => 'Steuerschlüssel',
   'taxnumber'                   => 'Automatikkonto',
+  'terminated'                  => 'gekündigt',
   'to (date)'                   => 'bis',
   'to (time)'                   => 'bis',
   'transfer'                    => 'Umlagerung',
@@ -2086,6 +2106,7 @@ $self->{texts} = {
   'warehouse_journal_list'      => 'lagerbuchungsliste',
   'warehouse_report_list'       => 'lagerbestandsliste',
   'wrongformat'                 => 'Falsches Format',
+  'yearly'                      => 'jährlich',
   'yes'                         => 'ja',
 };
 
diff --git a/modules/fallback/Daemon/Generic.pm b/modules/fallback/Daemon/Generic.pm
new file mode 100644
index 000000000..c185e8ae6
--- /dev/null
+++ b/modules/fallback/Daemon/Generic.pm
@@ -0,0 +1,553 @@
+
+# Copyright (C) 2006, David Muir Sharnoff <perl@dave.sharnoff.org>
+
+package Daemon::Generic;
+
+use strict;
+use warnings;
+require Exporter;
+require POSIX;
+use Getopt::Long;
+use File::Slurp;
+use File::Flock;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(newdaemon);
+
+our $VERSION = 0.71;
+
+our $force_quit_delay = 15;
+our $package = __PACKAGE__;
+our $caller;
+
+sub newdaemon
+{
+	my (%args) = @_;
+	my $pkg = $caller || caller() || 'main';
+
+	my $foo = bless {}, $pkg;
+
+	unless ($foo->isa($package)) {
+		no strict qw(refs);
+		my $isa = \@{"${pkg}::ISA"};
+		unshift(@$isa, $package);
+	}
+
+	bless $foo, 'This::Package::Does::Not::Exist';
+	undef $foo;
+
+	new($pkg, %args);
+}
+
+sub new
+{
+	my ($pkg, %args) = @_;
+
+	if ($pkg eq __PACKAGE__) {
+		$pkg = caller() || 'main';
+	}
+
+	srand(time ^ ($$ << 5))
+		unless $args{no_srand};
+
+	my $av0 = $0;
+	$av0 =~ s!/!/.!g;
+
+	my $self = {
+		gd_args		=> \%args,
+		gd_pidfile	=> $args{pidfile},
+		gd_logpriority	=> $args{logpriority},
+		gd_progname	=> $args{progname}
+					? $args{progname}
+					: $0,
+		gd_pidbase	=> $args{pidbase}
+					? $args{pidbase}
+					: ($args{progname} 
+						? "/var/run/$args{progname}"
+						: "/var/run/$av0"),
+		gd_foreground	=> $args{foreground} || 0,
+		configfile	=> $args{configfile}
+					? $args{configfile}
+					: ($args{progname}
+						? "/etc/$args{progname}.conf"
+						: "/etc/$av0"),
+		debug		=> $args{debug} || 0,
+	};
+	bless $self, $pkg;
+
+	$self->gd_getopt;
+	$self->gd_parse_argv;
+
+	my $do = $self->{do} = $ARGV[0];
+
+	$self->gd_help		if $do eq 'help';
+	$self->gd_version	if $do eq 'version';
+	$self->gd_install	if $do eq 'install';
+	$self->gd_uninstall	if $do eq 'uninstall';
+
+	$self->gd_pidfile unless $self->{gd_pidfile};
+
+	my %newconfig = $self->gd_preconfig;
+
+	$self->{gd_pidfile} = $newconfig{pidfile} if $newconfig{pidfile};
+
+	print "Configuration looks okay\n" if $do eq 'check';
+
+	my $pidfile = $self->{gd_pidfile};
+	my $killed = 0;
+	my $locked = 0;
+	if (-e $pidfile) {
+		if ($locked = lock($pidfile, undef, 'nonblocking')) {
+			# old process is dead
+			if ($do eq 'status') {
+			    print "$0 dead\n";
+			    exit 1;
+			}
+		} else {
+			sleep(2) if -M $pidfile < 2/86400;
+			my $oldpid = read_file($pidfile);
+			chomp($oldpid);
+			if ($oldpid) {
+				if ($do eq 'stop' or $do eq 'restart') {
+					$killed = $self->gd_kill($oldpid);
+					$locked = lock($pidfile);
+					if ($do eq 'stop') {
+						unlink($pidfile);
+						exit;
+					}
+				} elsif ($do eq 'reload') {
+					if (kill(1,$oldpid)) {
+						print "Requested reconfiguration\n";
+						exit;
+					} else {
+						print "Kill failed: $!\n";
+					}
+				} elsif ($do eq 'status') {
+					if (kill(0,$oldpid)) {
+						print "$0 running - pid $oldpid\n";
+						$self->gd_check($pidfile, $oldpid);
+						exit 0;
+					} else {
+						print "$0 dead\n";
+						exit 1;
+					}
+				} elsif ($do eq 'check') {
+					if (kill(0,$oldpid)) {
+						print "$0 running - pid $oldpid\n";
+						$self->gd_check($pidfile, $oldpid);
+						exit;
+					} 
+				} elsif ($do eq 'start') {
+					print "\u$self->{gd_progname} is already running (pid $oldpid)\n";
+					exit; # according to LSB, this is no error
+				}
+			} else {
+				$self->gd_error("Pid file $pidfile is invalid but locked, exiting\n");
+			}
+		}
+	} else {
+		$locked = lock($pidfile, undef, 'nonblocking') 
+			or die "Could not lock pid file $pidfile: $!";
+	}
+
+	if ($do eq 'reload' || $do eq 'stop' || $do eq 'check' || ($do eq 'restart' && ! $killed)) {
+		print "No $0 running\n";
+	}
+
+	if ($do eq 'stop') {
+		unlink($pidfile);
+		exit;
+	}
+
+	if ($do eq 'status') {
+		print "Unused\n";
+		exit 3;
+	}
+
+	if ($do eq 'check') {
+		$self->gd_check($pidfile);
+		exit 
+	}
+
+	unless ($do eq 'reload' || $do eq 'restart' || $do eq 'start') {
+		$self->gd_other_cmd($do, $locked);
+	}
+
+	unless ($self->{gd_foreground}) {
+		$self->gd_daemonize;
+	}
+
+	$locked or lock($pidfile, undef, 'nonblocking') 
+		or die "Could not lock PID file $pidfile: $!";
+
+	write_file($pidfile, "$$\n");
+
+	print STDERR "Starting up...\n";
+
+	$self->gd_postconfig(%newconfig);
+
+	$self->gd_setup_signals;
+
+	$self->gd_run;
+
+	unlink($pidfile);
+	exit(0);
+}
+
+sub gd_check {}
+
+sub gd_more_opt { return() }
+
+sub gd_getopt
+{
+	my $self = shift;
+	Getopt::Long::Configure("auto_version");
+	GetOptions(
+		'configfile=s'	=> \$self->{configfile},
+		'foreground!'	=> \$self->{gd_foreground},
+		'debug!'	=> \$self->{debug},
+		$self->{gd_args}{options}
+			? %{$self->{gd_args}{options}}
+			: (),
+		$self->gd_more_opt(),
+	) or exit($self->gd_usage());
+
+	if (@ARGV < ($self->{gd_args}{minimum_args} || 1)) {
+		exit($self->gd_usage());
+	}
+	if (@ARGV > ($self->{gd_args}{maximum_args} || 1)) {
+		exit($self->gd_usage());
+	}
+}
+
+sub gd_parse_argv { }
+
+sub gd_help
+{
+	my $self = shift;
+	exit($self->gd_usage($self->{gd_args}));
+}
+
+sub gd_version
+{
+	my $self = shift;
+	no strict qw(refs);
+	my $v = $self->{gd_args}{version} 
+		|| ${ref($self)."::VERSION"} 
+		|| $::VERSION 
+		|| $main::VERSION 
+		|| "?";
+	print "$self->{gd_progname} - version $v\n";;
+	exit;
+} 
+
+sub gd_pidfile
+{
+	my $self = shift;
+	my $x = $self->{configfile};
+	$x =~ s!/!.!g;
+	$self->{gd_pidfile} = "$self->{gd_pidbase}$x.pid";
+}
+
+sub gd_other_cmd
+{
+	my $self = shift;
+	$self->gd_usage;
+	exit(1);
+}
+
+sub gd_redirect_output
+{
+	my $self = shift;
+	return if $self->{gd_foreground};
+	my $logname = $self->gd_logname;
+	my $p = $self->{gd_logpriority} ? "-p $self->{gd_logpriority}" : "";
+	open(STDERR, "|logger $p -t '$logname'") or (print "could not open stderr: $!" && exit(1));
+	close(STDOUT);
+	open(STDOUT, ">&STDERR") or die "redirect STDOUT -> STDERR: $!";
+	close(STDIN);
+}
+
+sub gd_daemonize
+{
+	my $self = shift;
+	print "Starting $self->{gd_progname} server\n";
+	$self->gd_redirect_output();
+	my $pid;
+	POSIX::_exit(0) if $pid = fork;
+	die "Could not fork: $!" unless defined $pid;
+	POSIX::_exit(0) if $pid = fork;
+	die "Could not fork: $!" unless defined $pid;
+
+	POSIX::setsid();
+	select(STDERR);
+	$| = 1;
+	print "Sucessfully daemonized\n";
+}
+
+sub gd_logname
+{
+	my $self = shift;
+	return $self->{gd_progname}."[$$]";
+}
+
+sub gd_reconfig_event
+{
+	my $self = shift;
+	print STDERR "Reconfiguration requested\n";
+	$self->gd_postconfig($self->gd_preconfig());
+}
+
+sub gd_quit_event
+{
+	my $self = shift;
+	print STDERR "Quitting...\n";
+	exit(0);
+}
+
+sub gd_setup_signals
+{
+	my $self = shift;
+	$SIG{INT} = sub { $self->gd_quit_event() };
+	$SIG{HUP} = sub { $self->gd_reconfig_event() };
+}
+
+sub gd_run { die "must defined gd_run()" }
+
+sub gd_error
+{
+	my $self = shift;
+	my $e = shift;
+	my $do = $self->{do};
+	if ($do && $do eq 'stop') {
+		warn $e;
+	} else {
+		die $e;
+	}
+}
+
+sub gd_flags_more { return () }
+
+sub gd_flags
+{
+	my $self = shift;
+	return (
+		'-c file'	=> "Specify configuration file (instead of $self->{configfile})",
+		'-f'		=> "Run in the foreground (don't detach)",
+		$self->gd_flags_more
+	);
+}
+
+sub gd_commands_more { return () }
+
+sub gd_commands
+{
+	my $self = shift;
+	return (
+		start		=> "Starts a new $self->{gd_progname} if there isn't one running already",
+		stop		=> "Stops a running $self->{gd_progname}",
+		reload		=> "Causes a running $self->{gd_progname} to reload it's config file.  Starts a new one if none is running.",
+		restart		=> "Stops a running $self->{gd_progname} if one is running.  Starts a new one.",
+		$self->gd_commands_more(),
+		($self->gd_can_install()
+			? ('install' => "Setup $self->{gd_progname} to run automatically after reboot")
+			: ()),
+		($self->gd_can_uninstall()
+			? ('uninstall' => "Do not run $self->{gd_progname} after reboots")
+			: ()),
+		check		=> "Check the configuration file and report the daemon state",
+		help		=> "Display this usage info",
+		version		=> "Display the version of $self->{gd_progname}",
+	)
+}
+
+sub gd_positional_more { return() }
+
+sub gd_alts
+{
+	my $offset = shift;
+	my @results;
+	for (my $i = $offset; $i <= $#_; $i += 2) {
+		push(@results, $_[$i]);
+	}
+	return @results;
+}
+
+sub gd_usage
+{
+	my $self = shift;
+
+	require Text::Wrap;
+	import Text::Wrap;
+
+	my $col = 15;
+
+	my @flags = $self->gd_flags;
+	my @commands = $self->gd_commands;
+	my @positional = $self->gd_positional_more;
+
+	my $summary = "Usage: $self->{gd_progname} ";
+	my $details = '';
+	for my $i (gd_alts(0, @flags)) {
+		$summary .= "[ $i ] ";
+	}
+	$summary .= "{ ";
+	$summary .= join(" | ", gd_alts(0, @commands));
+	$summary .= " } ";
+	$summary .= join(" ", gd_alts(0, @positional));
+
+	my (@all) = (@flags, @commands, @positional);
+	while (@all) {
+		my ($key, $desc) = splice(@all, 0, 2);
+		local($Text::Wrap::columns) = 79;
+		$details .= wrap(
+			sprintf(" %-${col}s ", $key),
+			" " x ($col + 2),
+			$desc);
+		$details .= "\n";
+	}
+
+	print "$summary\n$details";
+	return 0;
+}
+
+sub gd_install_pre {}
+sub gd_install_post {}
+
+sub gd_can_install
+{
+	my $self = shift;
+	require File::Basename;
+	my $basename = File::Basename::basename($0);
+	if (
+		-x "/usr/sbin/update-rc.d"
+		&& 
+		-x $0
+		&& 
+		$0 !~ m{^(?:/usr|/var)?/tmp/}
+		&&
+		eval { symlink("",""); 1 }
+		&& 
+		-d "/etc/init.d"
+		&&
+		! -e "/etc/init.d/$basename"
+	) {
+		return sub {
+			$self->gd_install_pre("update-rc.d");
+			require Cwd;
+			my $abs_path = Cwd::abs_path($0);
+			symlink($abs_path, "/etc/init.d/$basename")
+				or die "Install failed: symlink /etc/init.d/$basename -> $abs_path: $!\n";
+			print "+ /usr/sbin/update-rc.d $basename defaults\n";
+			system("/usr/sbin/update-rc.d", $basename, "defaults");
+			my $exit = $? >> 8;
+			$self->gd_install_post("update-rc.d");
+			exit($exit) if $exit;
+		};
+	}
+
+	return 0;
+}
+
+sub gd_install
+{
+	my $self = shift;
+	my $ifunc = $self->gd_can_install();
+	die "Install command not supported\n" unless $ifunc;
+	&$ifunc($self);
+	exit(0);
+}
+
+sub gd_uninstall_pre {}
+sub gd_uninstall_post {}
+
+sub gd_can_uninstall
+{
+	my $self = shift;
+	require File::Basename;
+	my $basename = File::Basename::basename($0);
+	require Cwd;
+	my $abs_path = Cwd::abs_path($0) || 'no abs path';
+	my $link = readlink("/etc/init.d/$basename") || 'no link';
+	if (
+		$link eq $abs_path
+		&& 
+		-x "/usr/sbin/update-rc.d"
+	) {
+		return sub {
+			$self->gd_uninstall_pre("update-rc.d");
+			unlink("/etc/init.d/$basename");
+			print "+ /usr/sbin/update-rc.d $basename remove\n";
+			system("/usr/sbin/update-rc.d", $basename, "remove");
+			my $exit = $? >> 8;
+			$self->gd_uninstall_post("update-rc.d");
+			exit($exit) if $exit;
+		}
+	}
+	return 0;
+}
+
+sub gd_uninstall
+{
+	my $self = shift;
+	my $ufunc = $self->gd_can_uninstall();
+	die "Cannot uninstall\n" unless $ufunc;
+	&$ufunc($self);
+	exit(0);
+}
+
+sub gd_kill
+{
+	my ($self, $pid) = @_;
+
+	my $talkmore = 0;
+	my $killed = 0;
+	if (kill(0, $pid)) {
+		$killed = 1;
+		kill(2,$pid);
+		print "Killing $pid\n";
+		my $t = time;
+		sleep(1) if kill(0, $pid);
+		if ($force_quit_delay && kill(0, $pid)) {
+			print "Waiting for $pid to die...\n";
+			$talkmore = 1;
+			while(kill(0, $pid) && time - $t < $force_quit_delay) {
+				sleep(1);
+			}
+		}
+		if (kill(15, $pid)) {
+			print "Killing $pid with -TERM...\n";
+			if ($force_quit_delay) {
+				while(kill(0, $pid) && time - $t < $force_quit_delay * 2) {
+					sleep(1);
+				}
+			} else {
+				sleep(1) if kill(0, $pid);
+			}
+		}
+		if (kill(9, $pid)) {
+			print "Killing $pid with -KILL...\n";
+			my $k9 = time;
+			my $max = $force_quit_delay * 4;
+			$max = 60 if $max < 60;
+			while(kill(0, $pid)) {
+				if (time - $k9 > $max) {
+					print "Giving up on $pid ever dying.\n";
+					exit(1);
+				}
+				print "Waiting for $pid to die...\n";
+				sleep(1);
+			}
+		}
+		print "Process $pid is gone\n" if $talkmore;
+	} else {
+		print "Process $pid no longer running\n";
+	}
+	return $killed;
+}
+
+sub gd_preconfig { die "gd_preconfig() must be redefined"; }
+
+sub gd_postconfig { }
+
+
+1;
diff --git a/modules/fallback/Daemon/Generic/Event.pm b/modules/fallback/Daemon/Generic/Event.pm
new file mode 100644
index 000000000..2279a1ee9
--- /dev/null
+++ b/modules/fallback/Daemon/Generic/Event.pm
@@ -0,0 +1,126 @@
+
+# Copyright (C) 2006, David Muir Sharnoff <muir@idiom.com>
+
+package Daemon::Generic::Event;
+
+use strict;
+use warnings;
+require Daemon::Generic;
+require Event;
+require Exporter;
+
+our @ISA = qw(Daemon::Generic Exporter);
+our @EXPORT = @Daemon::Generic::EXPORT;
+our $VERSION = 0.3;
+
+sub newdaemon
+{
+	local($Daemon::Generic::caller) = caller() || 'main';
+	local($Daemon::Generic::package) = __PACKAGE__;
+	Daemon::Generic::newdaemon(@_);
+}
+
+sub gd_setup_signals
+{
+	my $self = shift;
+	my $reload_event = Event->signal(
+		signal	=> 'HUP',
+		desc	=> 'reload on SIGHUP',
+		prio	=> 6,
+		cb	=> sub { 
+			$self->gd_reconfig_event; 
+			$self->{gd_timer}->cancel()
+				if $self->{gd_timer};
+			$self->gd_setup_timer();
+		},
+	);
+	my $quit_event = Event->signal(
+		signal	=> 'INT',
+		cb	=> sub { $self->gd_quit_event; },
+	);
+}
+
+sub gd_setup_timer
+{
+	my $self = shift;
+	if ($self->can('gd_run_body')) {
+		my $interval = ($self->can('gd_interval') && $self->gd_interval()) || 1;
+		$self->{gd_timer} = Event->timer(
+			cb		=> [ $self, 'gd_run_body' ],
+			interval	=> $interval,
+			hard		=> 0,
+		);
+	}
+}
+
+sub gd_run
+{
+	my $self = shift;
+	$self->gd_setup_timer();
+	Event::loop();
+}
+
+sub gd_quit_event
+{
+	my $self = shift;
+	print STDERR "Quitting...\n";
+	Event::unloop_all();
+}
+
+1;
+
+=head1 NAME
+
+ Daemon::Generic::Event - Generic daemon framework with Event.pm
+
+=head1 SYNOPSIS
+
+ use Daemon::Generic::Event;
+
+ @ISA = qw(Daemon::Generic::Event);
+
+ sub gd_preconfig {
+	# stuff
+ }
+
+=head1 DESCRIPTION
+
+Daemon::Generic::Event is a subclass of L<Daemon::Generic> that
+predefines some methods:
+
+=over 15
+
+=item gd_run()
+
+Setup a periodic callback to C<gd_run_body()> if there is a C<gd_run_body()>.
+Call C<Event::loop()>.  
+
+=item gd_setup_signals()
+
+Bind SIGHUP to call C<gd_reconfig_event()>. 
+Bind SIGINT to call C<gd_quit_event()>.
+
+=back
+
+To use Daemon::Generic::Event, you have to provide a C<gd_preconfig()>
+method.   It can be empty if you have a C<gd_run_body()>.
+
+Set up your own events in C<gd_preconfig()> and C<gd_postconfig()>.
+
+If you have a C<gd_run_body()> method, it will be called once per
+second or every C<gd_interval()> seconds if you have a C<gd_interval()>
+method.  Unlike in L<Daemon::Generic::While1>, C<gd_run_body()> should
+not include a call to C<sleep()>.
+
+=head1 THANK THE AUTHOR
+
+If you need high-speed internet services (T1, T3, OC3 etc), please 
+send me your request-for-quote.  I have access to very good pricing:
+you'll save money and get a great service.
+
+=head1 LICENSE
+
+Copyright(C) 2006 David Muir Sharnoff <muir@idiom.com>. 
+This module may be used and distributed on the same terms
+as Perl itself.
+
diff --git a/modules/fallback/Daemon/Generic/While1.pm b/modules/fallback/Daemon/Generic/While1.pm
new file mode 100644
index 000000000..9c2691449
--- /dev/null
+++ b/modules/fallback/Daemon/Generic/While1.pm
@@ -0,0 +1,189 @@
+# Copyright (C) 2006, David Muir Sharnoff <muir@idiom.com>
+
+package Daemon::Generic::While1;
+
+use strict;
+use warnings;
+use Carp;
+require Daemon::Generic;
+require POSIX;
+require Exporter;
+
+our @ISA = qw(Daemon::Generic Exporter);
+our @EXPORT = @Daemon::Generic::EXPORT;
+our $VERSION = 0.3;
+
+sub newdaemon
+{
+	local($Daemon::Generic::caller) = caller() || 'main';
+	local($Daemon::Generic::package) = __PACKAGE__;
+	Daemon::Generic::newdaemon(@_);
+}
+
+sub gd_setup_signals
+{
+	my ($self) = @_;
+	$SIG{HUP} = sub {
+		$self->{gd_sighup} = time;
+	};
+	my $child;
+	$SIG{INT} = sub {
+		$self->{gd_sigint} = time;
+		#
+		# We'll be getting a SIGTERM in a bit if we're not dead, so let's use it.
+		#
+		$SIG{TERM} = sub {
+			$self->gd_quit_event(); 
+			kill(15, $child) if $child;  # if we're still alive, let's stay that way
+		};
+	};
+}
+
+sub gd_sleep
+{
+	my ($self, $period) = @_;
+	croak "Sleep period must be defined" unless defined $period;
+	my $hires;
+	if ($period*1000 != int($period*1000)) {
+		$hires = 1;
+		require Time::HiRes;
+		import Time::HiRes qw(time sleep);
+	}
+	my $t = time;
+	while (time - $t < $period) {
+		return if $self->{gd_sigint};
+		return if $self->{gd_sighup};
+		if ($hires) {
+			my $p = (time - $t < 1)
+				? time - $t
+				: 1;
+			sleep($p);
+		} else {
+			sleep(1);
+		}
+	}
+}
+
+sub gd_run
+{
+	my ($self) = @_;
+	while(1) {
+		if ($self->{gd_sigint}) {
+			$self->{gd_sigint} = 0;
+			$self->gd_quit_event();
+		}
+
+		if ($self->{gd_sighup}) {
+			$self->{gd_sighup} = 0;
+			$self->gd_reconfig_event();
+		}
+
+		$self->gd_run_body();
+	}
+}
+
+sub gd_reconfig_event
+{
+	my $self = shift;
+	print STDERR "Reconfiguration requested\n";
+	$self->gd_postconfig($self->gd_preconfig());
+}
+
+sub gd_quit_event
+{
+	print STDERR "Quitting...\n";
+	exit(0);
+}
+
+
+sub gd_run_body { die "must override gd_run_body()" }
+
+1;
+
+=head1 NAME
+
+ Daemon::Generic::While1 - Daemon framework with default while(1) loop
+
+=head1 SYNOPSIS
+
+ @ISA = qw(Daemon::Generic::While1);
+
+ sub gd_run_body {
+	# stuff
+ }
+
+=head1 DESCRIPTION
+
+This is a slight variation on L<Daemon::Generic>: a default
+C<gd_run()> provided.  It has a while(1) loop that calls 
+C<gd_run_body()> over and over.  It checks for reconifg and
+and terminate events and only actions them between calls
+to C<gd_run_body()>. 
+
+Terminate events will be forced through after 
+C<$Daemon::Generic::force_quit_delay> seconds if
+C<gd_run_body()> doesn't return quickly enough.
+
+=head1 SUBCLASS METHODS REQUIRD
+
+The following method is required to be overridden to subclass
+Daemon::Generic::While1:
+
+=over 15
+
+=item gd_run_body()
+
+This method will be called over and over.  This method should
+include a call to C<sleep(1)> (or a bit more).  Reconfig events
+will not interrupt it.  Quit events will only interrupt it 
+after 15 seconds.  
+
+=back
+
+=head1 ADDITIONAL METHODS
+
+The following additional methods are available for your use
+(as compared to L<Daemon::Generic>):
+
+=over 15
+
+=item gd_sleep($period)
+
+This will sleep for C<$period> seconds but in one-second
+intervals so that if a SIGINT or SIGHUP arrives the sleep
+period can end more quickly.
+
+Using this makes it safe for C<gd_run_body()> to sleep for
+longer than C<$Daemon::Generic::force_quit_delay> seconds 
+at a time.
+
+=back
+
+=head1 ADDITIONAL MEMBER DATA
+
+The following additional bits of member data are defined:
+
+=over 15
+
+=item gd_sigint
+
+The time at which an (unprocessed) SIGINT was recevied.
+
+=item gd_sighup
+
+The time at which an (unprocessed) SIGHUP was recevied.
+
+=back
+
+=head1 THANK THE AUTHOR
+
+If you need high-speed internet services (T1, T3, OC3 etc), please 
+send me your request-for-quote.  I have access to very good pricing:
+you'll save money and get a great service.
+
+=head1 LICENSE
+
+Copyright(C) 2006 David Muir Sharnoff <muir@idiom.com>. 
+This module may be used and distributed on the same terms
+as Perl itself.
+
diff --git a/modules/fallback/DateTime/Event/Cron.pm b/modules/fallback/DateTime/Event/Cron.pm
new file mode 100644
index 000000000..a835aa7c9
--- /dev/null
+++ b/modules/fallback/DateTime/Event/Cron.pm
@@ -0,0 +1,885 @@
+package DateTime::Event::Cron;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use vars qw($VERSION);
+
+$VERSION = '0.08';
+
+use constant DEBUG => 0;
+
+use DateTime;
+use DateTime::Set;
+use Set::Crontab;
+
+my %Object_Attributes;
+
+###
+
+sub from_cron {
+  # Return cron as DateTime::Set
+  my $class = shift;
+  my %sparms = @_ == 1 ? (cron => shift) : @_;
+  my %parms;
+  $parms{cron}      = delete $sparms{cron};
+  $parms{user_mode} = delete $sparms{user_mode};
+  $parms{cron} or croak "Cron string parameter required.\n";
+  my $dtc = $class->new(%parms);
+  $dtc->as_set(%sparms);
+}
+
+sub from_crontab {
+  # Return list of DateTime::Sets based on entries from
+  # a crontab file.
+  my $class = shift;
+  my %sparms = @_ == 1 ? (file => shift) : @_;
+  my $file = delete $sparms{file};
+  delete $sparms{cron};
+  my $fh = $class->_prepare_fh($file);
+  my @cronsets;
+  while (<$fh>) {
+    chomp;
+    my $set;
+    eval { $set = $class->from_cron(%sparms, cron => $_) };
+    push(@cronsets, $set) if ref $set && !$@;
+  }
+  @cronsets;
+}
+
+sub as_set {
+  # Return self as DateTime::Set
+  my $self = shift;
+  my %sparms = @_;
+  Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n"
+    if $sparms{next} || $sparms{recurrence} || $sparms{previous};
+  delete $sparms{next};
+  delete $sparms{previous};
+  delete $sparms{recurrence};
+  $sparms{next}     = sub { $self->next(@_) };
+  $sparms{previous} = sub { $self->previous(@_) };
+  DateTime::Set->from_recurrence(%sparms);
+}
+
+###
+
+sub new {
+  my $class = shift;
+  my $self = {};
+  bless $self, $class;
+  my %parms = @_ == 1 ? (cron => shift) : @_;
+  my $crontab = $self->_make_cronset(%parms);
+  $self->_cronset($crontab);
+  $self;
+}
+
+sub new_from_cron { new(@_) }
+
+sub new_from_crontab {
+  my $class = shift;
+  my %parms = @_ == 1 ? (file => shift()) : @_;
+  my $fh = $class->_prepare_fh($parms{file});
+  delete $parms{file};
+  my @dtcrons;
+  while (<$fh>) {
+    my $dtc;
+    eval { $dtc = $class->new(%parms, cron => $_) };
+    if (ref $dtc && !$@) {
+      push(@dtcrons, $dtc);
+      $parms{user_mode} = 1 if defined $dtc->user;
+    }
+  }
+  @dtcrons;
+}
+
+###
+
+sub _prepare_fh {
+  my $class = shift;
+  my $fh = shift;
+  if (! ref $fh) {
+    my $file = $fh;
+    local(*FH);
+    $fh = do { local *FH; *FH }; # doubled *FH avoids warning
+    open($fh, "<$file")
+      or croak "Error opening $file for reading\n";
+  }
+  $fh;
+}
+
+###
+
+sub valid {
+  # Is the given date valid according the current cron settings?
+  my($self, $date) = @_;
+  return if !$date || $date->second;
+  $self->minute->contains($date->minute)      &&
+  $self->hour->contains($date->hour)          &&
+  $self->days_contain($date->day, $date->dow) &&
+  $self->month->contains($date->month);
+}
+
+sub match {
+  # Does the given date match the cron spec?
+  my($self, $date) = @_;
+  $date = DateTime->now unless $date;
+  $self->minute->contains($date->minute)      &&
+  $self->hour->contains($date->hour)          &&
+  $self->days_contain($date->day, $date->dow) &&
+  $self->month->contains($date->month);
+}
+
+### Return adjacent dates without altering original date
+
+sub next {
+  my($self, $date) = @_;
+  $date = DateTime->now unless $date;
+  $self->increment($date->clone);
+}
+
+sub previous {
+  my($self, $date) = @_;
+  $date = DateTime->now unless $date;
+  $self->decrement($date->clone);
+}
+
+### Change given date to adjacent dates
+
+sub increment {
+  my($self, $date) = @_;
+  $date = DateTime->now unless $date;
+  return $date if $date->is_infinite;
+  do {
+    $self->_attempt_increment($date);
+  } until $self->valid($date);
+  $date;
+}
+
+sub decrement {
+  my($self, $date) = @_;
+  $date = DateTime->now unless $date;
+  return $date if $date->is_infinite;
+  do {
+    $self->_attempt_decrement($date);
+  } until $self->valid($date);
+  $date;
+}
+
+###
+
+sub _attempt_increment {
+  my($self, $date) = @_;
+  ref $date or croak "Reference to datetime object reqired\n";
+  $self->valid($date) ?
+    $self->_valid_incr($date) :
+    $self->_invalid_incr($date);
+}
+
+sub _attempt_decrement {
+  my($self, $date) = @_;
+  ref $date or croak "Reference to datetime object reqired\n";
+  $self->valid($date) ?
+    $self->_valid_decr($date) :
+    $self->_invalid_decr($date);
+}
+
+sub _valid_incr { shift->_minute_incr(@_) }
+
+sub _valid_decr { shift->_minute_decr(@_) }
+
+sub _invalid_incr {
+  # If provided date is valid, return it. Otherwise return
+  # nearest valid date after provided date.
+  my($self, $date) = @_;
+  ref $date or croak "Reference to datetime object reqired\n";
+
+  print STDERR "\nI GOT: ", $date->datetime, "\n" if DEBUG;
+
+  $date->truncate(to => 'minute')->add(minutes => 1)
+    if $date->second;
+
+  print STDERR "RND: ", $date->datetime, "\n" if DEBUG;
+
+  # Find our greatest invalid unit and clip
+  if (!$self->month->contains($date->month)) {
+    $date->truncate(to => 'month');
+  }
+  elsif (!$self->days_contain($date->day, $date->dow)) {
+    $date->truncate(to => 'day');
+  }
+  elsif (!$self->hour->contains($date->hour)) {
+    $date->truncate(to => 'hour');
+  }
+  else {
+    $date->truncate(to => 'minute');
+  }
+
+  print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
+
+  return $date if $self->valid($date);
+
+  print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
+
+  # Extraneous durations clipped. Start searching.
+  while (!$self->valid($date)) {
+    $date->add(months => 1) until $self->month->contains($date->month);
+    print STDERR "MON: ", $date->datetime, "\n" if DEBUG;
+
+    my $day_orig = $date->day;
+    $date->add(days => 1) until $self->days_contain($date->day, $date->dow);
+    $date->truncate(to => 'month') && next if $date->day < $day_orig;
+    print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
+
+    my $hour_orig = $date->hour;
+    $date->add(hours => 1) until $self->hour->contains($date->hour);
+    $date->truncate(to => 'day') && next if $date->hour < $hour_orig;
+    print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
+
+    my $min_orig = $date->minute;
+    $date->add(minutes => 1) until $self->minute->contains($date->minute);
+    $date->truncate(to => 'hour') && next if $date->minute < $min_orig;
+    print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
+  }
+  print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
+  $date;
+}
+
+sub _invalid_decr {
+  # If provided date is valid, return it. Otherwise
+  # return the nearest previous valid date.
+  my($self, $date) = @_;
+  ref $date or croak "Reference to datetime object reqired\n";
+
+  print STDERR "\nD GOT: ", $date->datetime, "\n" if DEBUG;
+
+  if (!$self->month->contains($date->month)) {
+    $date->truncate(to => 'month');
+  }
+  elsif (!$self->days_contain($date->day, $date->dow)) {
+    $date->truncate(to => 'day');
+  }
+  elsif (!$self->hour->contains($date->hour)) {
+    $date->truncate(to => 'hour');
+  }
+  else {
+    $date->truncate(to => 'minute');
+  }
+
+  print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
+
+  return $date if $self->valid($date);
+
+  print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
+
+  # Extraneous durations clipped. Start searching.
+  while (!$self->valid($date)) {
+    if (!$self->month->contains($date->month)) {
+      $date->subtract(months => 1) until $self->month->contains($date->month);
+      $self->_unit_peak($date, 'month');
+      print STDERR "MON: ", $date->datetime, "\n" if DEBUG;
+    }
+    if (!$self->days_contain($date->day, $date->dow)) {
+      my $day_orig = $date->day;
+      $date->subtract(days => 1)
+        until $self->days_contain($date->day, $date->dow);
+      $self->_unit_peak($date, 'month') && next if ($date->day > $day_orig);
+      $self->_unit_peak($date, 'day');
+      print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
+    }
+    if (!$self->hour->contains($date->hour)) {
+      my $hour_orig = $date->hour;
+      $date->subtract(hours => 1) until $self->hour->contains($date->hour);
+      $self->_unit_peak($date, 'day') && next if ($date->hour > $hour_orig);
+      $self->_unit_peak($date, 'hour');
+      print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
+    }
+    if (!$self->minute->contains($date->minute)) {
+      my $min_orig = $date->minute;
+      $date->subtract(minutes => 1)
+        until $self->minute->contains($date->minute);
+      $self->_unit_peak($date, 'hour') && next if ($date->minute > $min_orig);
+      print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
+    }
+  }
+  print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
+  $date;
+}
+
+###
+
+sub _unit_peak {
+  my($self, $date, $unit) = @_;
+  $date && $unit or croak "DateTime ref and unit required.\n";
+  $date->truncate(to => $unit)
+       ->add($unit . 's' => 1)
+       ->subtract(minutes => 1);
+}
+
+### Unit cascades
+
+sub _minute_incr {
+  my($self, $date) = @_;
+  croak "datetime object required\n" unless $date;
+  my $cur = $date->minute;
+  my $next = $self->minute->next($cur);
+  $date->set(minute => $next);
+  $next <= $cur ? $self->_hour_incr($date) : $date;
+}
+
+sub _hour_incr {
+  my($self, $date) = @_;
+  croak "datetime object required\n" unless $date;
+  my $cur = $date->hour;
+  my $next = $self->hour->next($cur);
+  $date->set(hour => $next);
+  $next <= $cur ? $self->_day_incr($date) : $date;
+}
+
+sub _day_incr {
+  my($self, $date) = @_;
+  croak "datetime object required\n" unless $date;
+  $date->add(days => 1);
+  $self->_invalid_incr($date);
+}
+
+sub _minute_decr {
+  my($self, $date) = @_;
+  croak "datetime object required\n" unless $date;
+  my $cur = $date->minute;
+  my $next = $self->minute->previous($cur);
+  $date->set(minute => $next);
+  $next >= $cur ? $self->_hour_decr($date) : $date;
+}
+
+sub _hour_decr {
+  my($self, $date) = @_;
+  croak "datetime object required\n" unless $date;
+  my $cur = $date->hour;
+  my $next = $self->hour->previous($cur);
+  $date->set(hour => $next);
+  $next >= $cur ? $self->_day_decr($date) : $date;
+}
+
+sub _day_decr {
+  my($self, $date) = @_;
+  croak "datetime object required\n" unless $date;
+  $date->subtract(days => 1);
+  $self->_invalid_decr($date);
+}
+
+### Factories
+
+sub _make_cronset { shift; DateTime::Event::Cron::IntegratedSet->new(@_) }
+
+### Shortcuts
+
+sub days_contain { shift->_cronset->days_contain(@_) }
+
+sub minute   { shift->_cronset->minute  }
+sub hour     { shift->_cronset->hour    }
+sub day      { shift->_cronset->day     }
+sub month    { shift->_cronset->month   }
+sub dow      { shift->_cronset->dow     }
+sub user     { shift->_cronset->user    }
+sub command  { shift->_cronset->command }
+sub original { shift->_cronset->original }
+
+### Static acessors/mutators
+
+sub _cronset { shift->_attr('cronset', @_) }
+
+sub _attr {
+  my $self = shift;
+  my $name = shift;
+  if (@_) {
+    $Object_Attributes{$self}{$name} = shift;
+  }
+  $Object_Attributes{$self}{$name};
+}
+
+### debugging
+
+sub _dump_sets {
+  my($self, $date) = @_;
+  foreach (qw(minute hour day month dow)) {
+    print STDERR "$_: ", join(',',$self->$_->list), "\n";
+  }
+  if (ref $date) {
+    $date = $date->clone;
+    my @mod;
+    my $mon = $date->month;
+    $date->truncate(to => 'month');
+    while ($date->month == $mon) {
+      push(@mod, $date->day) if $self->days_contain($date->day, $date->dow);
+      $date->add(days => 1);
+    }
+    print STDERR "mod for month($mon): ", join(',', @mod), "\n";
+  }
+  print STDERR "day_squelch: ", $self->_cronset->day_squelch, " ",
+               "dow_squelch: ", $self->_cronset->dow_squelch, "\n";
+  $self;
+}
+
+###
+
+sub DESTROY { delete $Object_Attributes{shift()} }
+
+##########
+
+{
+
+package DateTime::Event::Cron::IntegratedSet;
+
+# IntegratedSet manages the collection of field sets for
+# each cron entry, including sanity checks. Individual
+# field sets are accessed through their respective names,
+# i.e., minute hour day month dow.
+#
+# Also implements some merged field logic for day/dow
+# interactions.
+
+use strict;
+use Carp;
+
+my %Range = (
+  minute => [0..59],
+  hour   => [0..23],
+  day    => [1..31],
+  month  => [1..12],
+  dow    => [1..7],
+);
+
+my @Month_Max = qw( 31 29 31 30 31 30 31 31 30 31 30 31 );
+
+my %Object_Attributes;
+
+sub new {
+  my $self = [];
+  bless $self, shift;
+  $self->_range(\%Range);
+  $self->set_cron(@_);
+  $self;
+}
+
+sub set_cron {
+  # Initialize
+  my $self = shift;
+  my %parms = @_;
+  my $cron = $parms{cron};
+  my $user_mode = $parms{user_mode};
+  defined $cron or croak "Cron entry fields required\n";
+  $self->_attr('original', $cron);
+  my @line;
+  if (ref $cron) {
+    @line = grep(!/^\s*$/, @$cron);
+  }
+  else {
+    $cron =~ s/^\s+//;
+    $cron =~ s/\s+$//;
+    @line = split(/\s+/, $cron);
+  }
+  @line >= 5 or croak "At least five cron entry fields required.\n";
+  my @entry = splice(@line, 0, 5);
+  my($user, $command);
+  unless (defined $user_mode) {
+    # auto-detect
+    if (@line > 1 && $line[0] =~ /^\w+$/) {
+      $user_mode = 1;
+    }
+  }
+  $user = shift @line if $user_mode;
+  $command = join(' ', @line);
+  $self->_attr('command', $command);
+  $self->_attr('user', $user);
+  my $i = 0;
+  foreach my $name (qw( minute hour day month dow )) {
+    $self->_attr($name, $self->make_valid_set($name, $entry[$i]));
+    ++$i;
+  }
+  my @day_list  = $self->day->list;
+  my @dow_list  = $self->dow->list;
+  my $day_range = $self->range('day');
+  my $dow_range = $self->range('dow');
+  $self->day_squelch(scalar @day_list == scalar @$day_range &&
+                     scalar @dow_list != scalar @$dow_range ? 1 : 0);
+  $self->dow_squelch(scalar @dow_list == scalar @$dow_range &&
+                     scalar @day_list != scalar @$day_range ? 1 : 0);
+  unless ($self->day_squelch) {
+    my @days = $self->day->list;
+    my $pass = 0;
+    MONTH: foreach my $month ($self->month->list) {
+      foreach (@days) {
+        ++$pass && last MONTH if $_ <= $Month_Max[$month - 1];
+      }
+    }
+    croak "Impossible last day for provided months.\n" unless $pass;
+  }
+  $self;
+}
+
+# Field range queries
+sub range {
+  my($self, $name) = @_;
+  my $val = $self->_range->{$name} or croak "Unknown field '$name'\n";
+  $val;
+}
+
+# Perform sanity checks when setting up each field set.
+sub make_valid_set {
+  my($self, $name, $str) = @_;
+  my $range = $self->range($name);
+  my $set = $self->make_set($str, $range);
+  my @list = $set->list;
+  croak "Malformed cron field '$str'\n" unless @list;
+  croak "Field value ($list[-1]) out of range ($range->[0]-$range->[-1])\n"
+    if $list[-1] > $range->[-1];
+  if ($name eq 'dow' && $set->contains(0)) {
+    shift(@list);
+    push(@list, 7) unless $set->contains(7);
+    $set = $self->make_set(join(',',@list), $range);
+  }
+  croak "Field value ($list[0]) out of range ($range->[0]-$range->[-1])\n"
+    if $list[0] < $range->[0];
+  $set;
+}
+
+# No sanity checks
+sub make_set { shift; DateTime::Event::Cron::OrderedSet->new(@_) }
+
+# Flags for when day/dow are applied.
+sub day_squelch { shift->_attr('day_squelch', @_ ) }
+sub dow_squelch { shift->_attr('dow_squelch', @_ ) }
+
+# Merged logic for day/dow
+sub days_contain {
+  my($self, $day, $dow) = @_;
+  defined $day && defined $dow
+    or croak "Day of month and day of week required.\n";
+  my $day_c = $self->day->contains($day);
+  my $dow_c = $self->dow->contains($dow);
+  return $dow_c if $self->day_squelch;
+  return $day_c if $self->dow_squelch;
+  $day_c || $dow_c;
+}
+
+# Set Accessors
+sub minute   { shift->_attr('minute' ) }
+sub hour     { shift->_attr('hour'   ) }
+sub day      { shift->_attr('day'    ) }
+sub month    { shift->_attr('month'  ) }
+sub dow      { shift->_attr('dow'    ) }
+sub user     { shift->_attr('user'   ) }
+sub command  { shift->_attr('command') }
+sub original { shift->_attr('original') }
+
+# Accessors/mutators
+sub _range       { shift->_attr('range', @_) }
+
+sub _attr {
+  my $self = shift;
+  my $name = shift;
+  if (@_) {
+    $Object_Attributes{$self}{$name} = shift;
+  }
+  $Object_Attributes{$self}{$name};
+}
+
+sub DESTROY { delete $Object_Attributes{shift()} }
+
+}
+
+##########
+
+{
+
+package DateTime::Event::Cron::OrderedSet;
+
+# Extends Set::Crontab with some progression logic (next/prev)
+
+use strict;
+use Carp;
+use base 'Set::Crontab';
+
+my %Object_Attributes;
+
+sub new {
+  my $class = shift;
+  my($string, $range) = @_;
+  defined $string && ref $range
+    or croak "Cron field and range ref required.\n";
+  my $self = Set::Crontab->new($string, $range);
+  bless $self, $class;
+  my @list = $self->list;
+  my(%next, %prev);
+  foreach (0 .. $#list) {
+    $next{$list[$_]} = $list[($_+1)%@list];
+    $prev{$list[$_]} = $list[($_-1)%@list];
+  }
+  $self->_attr('next', \%next);
+  $self->_attr('previous', \%prev);
+  $self;
+}
+
+sub next {
+  my($self, $entry) = @_;
+  my $hash = $self->_attr('next');
+  croak "Missing entry($entry) in set\n" unless exists $hash->{$entry};
+  my $next = $hash->{$entry};
+  wantarray ? ($next, $next <= $entry) : $next;
+}
+
+sub previous {
+  my($self, $entry) = @_;
+  my $hash = $self->_attr('previous');
+  croak "Missing entry($entry) in set\n" unless exists $hash->{$entry};
+  my $prev = $hash->{$entry};
+  wantarray ? ($prev, $prev >= $entry) : $prev;
+}
+
+sub _attr {
+  my $self = shift;
+  my $name = shift;
+  if (@_) {
+    $Object_Attributes{$self}{$name} = shift;
+  }
+  $Object_Attributes{$self}{$name};
+}
+
+sub DESTROY { delete $Object_Attributes{shift()} }
+
+}
+
+###
+
+1;
+
+__END__
+
+=head1 NAME
+
+DateTime::Event::Cron - DateTime extension for generating recurrence
+sets from crontab lines and files.
+
+=head1 SYNOPSIS
+
+  use DateTime::Event::Cron;
+
+  # check if a date matches (defaults to current time)
+  my $c = DateTime::Event::Cron->new('* 2 * * *');
+  if ($c->match) {
+    # do stuff
+  }
+  if ($c->match($date)) {
+    # do something else for datetime $date
+  }
+
+  # DateTime::Set construction from crontab line
+  $crontab = '*/3 15 1-10 3,4,5 */2';
+  $set = DateTime::Event::Cron->from_cron($crontab);
+  $iter = $set->iterator(after => DateTime->now);
+  while (1) {
+    my $next = $iter->next;
+    my $now  = DateTime->now;
+    sleep(($next->subtract_datetime_absolute($now))->seconds);
+    # do stuff...
+  }
+
+  # List of DateTime::Set objects from crontab file
+  @sets = DateTime::Event::Cron->from_crontab(file => '/etc/crontab');
+  $now = DateTime->now;
+  print "Now: ", $now->datetime, "\n";
+  foreach (@sets) {
+    my $next = $_->next($now);
+    print $next->datetime, "\n";
+  }
+
+  # DateTime::Set parameters
+  $crontab = '* * * * *';
+
+  $now = DateTime->now;
+  %set_parms = ( after => $now );
+  $set = DateTime::Event::Cron->from_cron(cron => $crontab, %set_parms);
+  $dt = $set->next;
+  print "Now: ", $now->datetime, " and next: ", $dt->datetime, "\n";
+
+  # Spans for DateTime::Set
+  $crontab = '* * * * *';
+  $now = DateTime->now;
+  $now2 = $now->clone;
+  $span = DateTime::Span->from_datetimes(
+            start => $now->add(minutes => 1),
+	    end   => $now2->add(hours => 1),
+	  );
+  %parms = (cron => $crontab, span => $span);
+  $set = DateTime::Event::Cron->from_cron(%parms);
+  # ...do things with the DateTime::Set
+
+  # Every RTFCT relative to 12am Jan 1st this year
+  $crontab = '7-10 6,12-15 10-28/2 */3 3,4,5';
+  $date = DateTime->now->truncate(to => 'year');
+  $set = DateTime::Event::Cron->from_cron(cron => $crontab, after => $date);
+
+  # Rather than generating DateTime::Set objects, next/prev
+  # calculations can be made directly:
+
+  # Every day at 10am, 2pm, and 6pm. Reference date
+  # defaults to DateTime->now.
+  $crontab = '10,14,18 * * * *';
+  $dtc = DateTime::Event::Cron->new_from_cron(cron => $crontab);
+  $next_datetime = $dtc->next;
+  $last_datetime = $dtc->previous;
+  ...
+
+  # List of DateTime::Event::Cron objects from
+  # crontab file
+  @dtc = DateTime::Event::Cron->new_from_crontab(file => '/etc/crontab');
+
+  # Full cron lines with user, such as from /etc/crontab
+  # or files in /etc/cron.d, are supported and auto-detected:
+  $crontab = '* * * * * gump /bin/date';
+  $dtc = DateTime::Event::Cron->new(cron => $crontab);
+
+  # Auto-detection of users is disabled if you explicitly
+  # enable/disable via the user_mode parameter:
+  $dtc = DateTime::Event::Cron->new(cron => $crontab, user_mode => 1);
+  my $user = $dtc->user;
+  my $command = $dtc->command;
+
+  # Unparsed original cron entry
+  my $original = $dtc->original;
+
+=head1 DESCRIPTION
+
+DateTime::Event::Cron generated DateTime events or DateTime::Set objects
+based on crontab-style entries.
+
+=head1 METHODS
+
+The cron fields are typical crontab-style entries. For more information,
+see L<crontab(5)> and extensions described in L<Set::Crontab>. The
+fields can be passed as a single string or as a reference to an array
+containing each field. Only the first five fields are retained.
+
+=head2 DateTime::Set Factories
+
+See L<DateTime::Set> for methods provided by Set objects, such as
+C<next()> and C<previous()>.
+
+=over 4
+
+=item from_cron($cronline)
+
+=item from_cron(cron => $cronline, %parms, %set_parms)
+
+Generates a DateTime::Set recurrence for the cron line provided. See
+new() for details on %parms. Optionally takes parameters for
+DateTime::Set.
+
+=item from_crontab(file => $crontab_fh, %parms, %set_parms)
+
+Returns a list of DateTime::Set recurrences based on lines from a
+crontab file. C<$crontab_fh> can be either a filename or filehandle
+reference. See new() for details on %parm. Optionally takes parameters
+for DateTime::Set which will be passed along to each set for each line.
+
+=item as_set(%set_parms)
+
+Generates a DateTime::Set recurrence from an existing
+DateTime::Event::Cron object.
+
+=back
+
+=head2 Constructors
+
+=over 4
+
+=item new_from_cron(cron => $cronstring, %parms)
+
+Returns a DateTime::Event::Cron object based on the cron specification.
+Optional parameters include the boolean 'user_mode' which indicates that
+the crontab entry includes a username column before the command.
+
+=item new_from_crontab(file => $fh, %parms)
+
+Returns a list of DateTime::Event::Cron objects based on the lines of a
+crontab file. C<$fh> can be either a filename or a filehandle reference.
+Optional parameters include the boolean 'user_mode' as mentioned above.
+
+=back
+
+=head2 Other methods
+
+=over 4
+
+=item next()
+
+=item next($date)
+
+Returns the next valid datetime according to the cron specification.
+C<$date> defaults to DateTime->now unless provided.
+
+=item previous()
+
+=item previous($date)
+
+Returns the previous valid datetime according to the cron specification.
+C<$date> defaults to DateTime->now unless provided.
+
+=item increment($date)
+
+=item decrement($date)
+
+Same as C<next()> and C<previous()> except that the provided datetime is
+modified to the new datetime.
+
+=item match($date)
+
+Returns whether or not the given datetime (defaults to current time)
+matches the current cron specification. Dates are truncated to minute
+resolution.
+
+=item valid($date)
+
+A more strict version of match(). Returns whether the given datetime is
+valid under the current cron specification. Cron dates are only accurate
+to the minute -- datetimes with seconds greater than 0 are invalid by
+default. (note: never fear, all methods accepting dates will accept
+invalid dates -- they will simply be rounded to the next nearest valid
+date in all cases except this particular method)
+
+=item command()
+
+Returns the command string, if any, from the original crontab entry.
+Currently no expansion is performed such as resolving environment
+variables, etc.
+
+=item user()
+
+Returns the username under which this cron command was to be executed,
+assuming such a field was present in the original cron entry.
+
+=item original()
+
+Returns the original, unparsed cron string including any user or
+command fields.
+
+=back
+
+=head1 AUTHOR
+
+Matthew P. Sisk E<lt>sisk@mojotoad.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003 Matthew P. Sisk. All rights reserved. All wrongs
+revenged. This program is free software; you can distribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+DateTime(3), DateTime::Set(3), DateTime::Event::Recurrence(3),
+DateTime::Event::ICal(3), DateTime::Span(3), Set::Crontab(3), crontab(5)
+
+=cut
diff --git a/modules/fallback/DateTime/Set.pm b/modules/fallback/DateTime/Set.pm
new file mode 100644
index 000000000..05fac96e9
--- /dev/null
+++ b/modules/fallback/DateTime/Set.pm
@@ -0,0 +1,1149 @@
+
+package DateTime::Set;
+
+use strict;
+use Carp;
+use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
+use DateTime 0.12;  # this is for version checking only
+use DateTime::Duration;
+use DateTime::Span;
+use Set::Infinite 0.59;
+use Set::Infinite::_recurrence;
+
+use vars qw( $VERSION );
+
+use constant INFINITY     =>       100 ** 100 ** 100 ;
+use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
+
+BEGIN {
+    $VERSION = '0.28';
+}
+
+
+sub _fix_datetime {
+    # internal function -
+    # (not a class method)
+    #
+    # checks that the parameter is an object, and
+    # also protects the object against mutation
+    
+    return $_[0]
+        unless defined $_[0];      # error
+    return $_[0]->clone
+        if ref( $_[0] );           # "immutable" datetime
+    return DateTime::Infinite::Future->new 
+        if $_[0] == INFINITY;      # Inf
+    return DateTime::Infinite::Past->new
+        if $_[0] == NEG_INFINITY;  # -Inf
+    return $_[0];                  # error
+}
+
+sub _fix_return_datetime {
+    my ( $dt, $dt_arg ) = @_;
+
+    # internal function -
+    # (not a class method)
+    #
+    # checks that the returned datetime has the same
+    # time zone as the parameter
+
+    # TODO: set locale
+
+    return unless $dt;
+    return unless $dt_arg;
+    if ( $dt_arg->can('time_zone_long_name') &&
+         !( $dt_arg->time_zone_long_name eq 'floating' ) )
+    {
+        $dt->set_time_zone( $dt_arg->time_zone );
+    }
+    return $dt;
+}
+
+sub iterate {
+    # deprecated method - use map() or grep() instead
+    my ( $self, $callback ) = @_;
+    my $class = ref( $self );
+    my $return = $class->empty_set;
+    $return->{set} = $self->{set}->iterate( 
+        sub {
+            my $min = $_[0]->min;
+            $callback->( $min->clone ) if ref($min);
+        }
+    );
+    $return;
+}
+
+sub map {
+    my ( $self, $callback ) = @_;
+    my $class = ref( $self );
+    die "The callback parameter to map() must be a subroutine reference"
+        unless ref( $callback ) eq 'CODE';
+    my $return = $class->empty_set;
+    $return->{set} = $self->{set}->iterate( 
+        sub {
+            local $_ = $_[0]->min;
+            next unless ref( $_ );
+            $_ = $_->clone;
+            my @list = $callback->();
+            my $set = Set::Infinite::_recurrence->new();
+            $set = $set->union( $_ ) for @list;
+            return $set;
+        }
+    );
+    $return;
+}
+
+sub grep {
+    my ( $self, $callback ) = @_;
+    my $class = ref( $self );
+    die "The callback parameter to grep() must be a subroutine reference"
+        unless ref( $callback ) eq 'CODE';
+    my $return = $class->empty_set;
+    $return->{set} = $self->{set}->iterate( 
+        sub {
+            local $_ = $_[0]->min;
+            next unless ref( $_ );
+            $_ = $_->clone;
+            my $result = $callback->();
+            return $_ if $result;
+            return;
+        }
+    );
+    $return;
+}
+
+sub add { return shift->add_duration( DateTime::Duration->new(@_) ) }
+
+sub subtract { return shift->subtract_duration( DateTime::Duration->new(@_) ) }
+
+sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }
+
+sub add_duration {
+    my ( $self, $dur ) = @_;
+    $dur = $dur->clone;  # $dur must be "immutable"
+
+    $self->{set} = $self->{set}->iterate(
+        sub {
+            my $min = $_[0]->min;
+            $min->clone->add_duration( $dur ) if ref($min);
+        },
+        backtrack_callback => sub { 
+            my ( $min, $max ) = ( $_[0]->min, $_[0]->max );
+            if ( ref($min) )
+            {
+                $min = $min->clone;
+                $min->subtract_duration( $dur );
+            }
+            if ( ref($max) )
+            {
+                $max = $max->clone;
+                $max->subtract_duration( $dur );
+            }
+            return Set::Infinite::_recurrence->new( $min, $max );
+        },
+    );
+    $self;
+}
+
+sub set_time_zone {
+    my ( $self, $tz ) = @_;
+
+    $self->{set} = $self->{set}->iterate(
+        sub {
+            my $min = $_[0]->min;
+            $min->clone->set_time_zone( $tz ) if ref($min);
+        },
+        backtrack_callback => sub {
+            my ( $min, $max ) = ( $_[0]->min, $_[0]->max );
+            if ( ref($min) )
+            {
+                $min = $min->clone;
+                $min->set_time_zone( $tz );
+            }
+            if ( ref($max) )
+            {
+                $max = $max->clone;
+                $max->set_time_zone( $tz );
+            }
+            return Set::Infinite::_recurrence->new( $min, $max );
+        },
+    );
+    $self;
+}
+
+sub set {
+    my $self = shift;
+    my %args = validate( @_,
+                         { locale => { type => SCALAR | OBJECT,
+                                       default => undef },
+                         }
+                       );
+    $self->{set} = $self->{set}->iterate( 
+        sub {
+            my $min = $_[0]->min;
+            $min->clone->set( %args ) if ref($min);
+        },
+    );
+    $self;
+}
+
+sub from_recurrence {
+    my $class = shift;
+
+    my %args = @_;
+    my %param;
+    
+    # Parameter renaming, such that we can use either
+    #   recurrence => xxx   or   next => xxx, previous => xxx
+    $param{next} = delete $args{recurrence} || delete $args{next};
+    $param{previous} = delete $args{previous};
+
+    $param{span} = delete $args{span};
+    # they might be specifying a span using begin / end
+    $param{span} = DateTime::Span->new( %args ) if keys %args;
+
+    my $self = {};
+    
+    die "Not enough arguments in from_recurrence()"
+        unless $param{next} || $param{previous}; 
+
+    if ( ! $param{previous} ) 
+    {
+        my $data = {};
+        $param{previous} =
+                sub {
+                    _callback_previous ( _fix_datetime( $_[0] ), $param{next}, $data );
+                }
+    }
+    else
+    {
+        my $previous = $param{previous};
+        $param{previous} =
+                sub {
+                    $previous->( _fix_datetime( $_[0] ) );
+                }
+    }
+
+    if ( ! $param{next} ) 
+    {
+        my $data = {};
+        $param{next} =
+                sub {
+                    _callback_next ( _fix_datetime( $_[0] ), $param{previous}, $data );
+                }
+    }
+    else
+    {
+        my $next = $param{next};
+        $param{next} =
+                sub {
+                    $next->( _fix_datetime( $_[0] ) );
+                }
+    }
+
+    my ( $min, $max );
+    $max = $param{previous}->( DateTime::Infinite::Future->new );
+    $min = $param{next}->( DateTime::Infinite::Past->new );
+    $max = INFINITY if $max->is_infinite;
+    $min = NEG_INFINITY if $min->is_infinite;
+        
+    my $base_set = Set::Infinite::_recurrence->new( $min, $max );
+    $base_set = $base_set->intersection( $param{span}->{set} )
+         if $param{span};
+         
+    # warn "base set is $base_set\n";
+
+    my $data = {};
+    $self->{set} = 
+            $base_set->_recurrence(
+                $param{next}, 
+                $param{previous},
+                $data,
+        );
+    bless $self, $class;
+    
+    return $self;
+}
+
+sub from_datetimes {
+    my $class = shift;
+    my %args = validate( @_,
+                         { dates => 
+                           { type => ARRAYREF,
+                           },
+                         }
+                       );
+    my $self = {};
+    $self->{set} = Set::Infinite::_recurrence->new;
+    # possible optimization: sort datetimes and use "push"
+    for( @{ $args{dates} } ) 
+    {
+        # DateTime::Infinite objects are not welcome here,
+        # but this is not enforced (it does't hurt)
+
+        carp "The 'dates' argument to from_datetimes() must only contain ".
+             "datetime objects"
+            unless UNIVERSAL::can( $_, 'utc_rd_values' );
+
+        $self->{set} = $self->{set}->union( $_->clone );
+    }
+
+    bless $self, $class;
+    return $self;
+}
+
+sub empty_set {
+    my $class = shift;
+
+    return bless { set => Set::Infinite::_recurrence->new }, $class;
+}
+
+sub clone { 
+    my $self = bless { %{ $_[0] } }, ref $_[0];
+    $self->{set} = $_[0]->{set}->copy;
+    return $self;
+}
+
+# default callback that returns the 
+# "previous" value in a callback recurrence.
+#
+# This is used to simulate a 'previous' callback,
+# when then 'previous' argument in 'from_recurrence' is missing.
+#
+sub _callback_previous {
+    my ($value, $callback_next, $callback_info) = @_; 
+    my $previous = $value->clone;
+
+    return $value if $value->is_infinite;
+
+    my $freq = $callback_info->{freq};
+    unless (defined $freq) 
+    { 
+        # This is called just once, to setup the recurrence frequency
+        my $previous = $callback_next->( $value );
+        my $next =     $callback_next->( $previous );
+        $freq = 2 * ( $previous - $next );
+        # save it for future use with this same recurrence
+        $callback_info->{freq} = $freq;
+    }
+
+    $previous->add_duration( $freq );  
+    $previous = $callback_next->( $previous );
+    if ($previous >= $value) 
+    {
+        # This error happens if the event frequency oscilates widely
+        # (more than 100% of difference from one interval to next)
+        my @freq = $freq->deltas;
+        print STDERR "_callback_previous: Delta components are: @freq\n";
+        warn "_callback_previous: iterator can't find a previous value, got ".
+            $previous->ymd." after ".$value->ymd;
+    }
+    my $previous1;
+    while (1) 
+    {
+        $previous1 = $previous->clone;
+        $previous = $callback_next->( $previous );
+        return $previous1 if $previous >= $value;
+    }
+}
+
+# default callback that returns the 
+# "next" value in a callback recurrence.
+#
+# This is used to simulate a 'next' callback,
+# when then 'next' argument in 'from_recurrence' is missing.
+#
+sub _callback_next {
+    my ($value, $callback_previous, $callback_info) = @_; 
+    my $next = $value->clone;
+
+    return $value if $value->is_infinite;
+
+    my $freq = $callback_info->{freq};
+    unless (defined $freq) 
+    { 
+        # This is called just once, to setup the recurrence frequency
+        my $next =     $callback_previous->( $value );
+        my $previous = $callback_previous->( $next );
+        $freq = 2 * ( $next - $previous );
+        # save it for future use with this same recurrence
+        $callback_info->{freq} = $freq;
+    }
+
+    $next->add_duration( $freq );  
+    $next = $callback_previous->( $next );
+    if ($next <= $value) 
+    {
+        # This error happens if the event frequency oscilates widely
+        # (more than 100% of difference from one interval to next)
+        my @freq = $freq->deltas;
+        print STDERR "_callback_next: Delta components are: @freq\n";
+        warn "_callback_next: iterator can't find a previous value, got ".
+            $next->ymd." before ".$value->ymd;
+    }
+    my $next1;
+    while (1) 
+    {
+        $next1 = $next->clone;
+        $next =  $callback_previous->( $next );
+        return $next1 if $next >= $value;
+    }
+}
+
+sub iterator {
+    my $self = shift;
+
+    my %args = @_;
+    my $span;
+    $span = delete $args{span};
+    $span = DateTime::Span->new( %args ) if %args;
+
+    return $self->intersection( $span ) if $span;
+    return $self->clone;
+}
+
+
+# next() gets the next element from an iterator()
+# next( $dt ) returns the next element after a datetime.
+sub next {
+    my $self = shift;
+    return undef unless ref( $self->{set} );
+
+    if ( @_ ) 
+    {
+        if ( $self->{set}->_is_recurrence )
+        {
+            return _fix_return_datetime(
+                       $self->{set}->{param}[0]->( $_[0] ), $_[0] );
+        }
+        else 
+        {
+            my $span = DateTime::Span->from_datetimes( after => $_[0] );
+            return _fix_return_datetime(
+                        $self->intersection( $span )->next, $_[0] );
+        }
+    }
+
+    my ($head, $tail) = $self->{set}->first;
+    $self->{set} = $tail;
+    return $head->min if defined $head;
+    return $head;
+}
+
+# previous() gets the last element from an iterator()
+# previous( $dt ) returns the previous element before a datetime.
+sub previous {
+    my $self = shift;
+    return undef unless ref( $self->{set} );
+
+    if ( @_ ) 
+    {
+        if ( $self->{set}->_is_recurrence ) 
+        {
+            return _fix_return_datetime(
+                      $self->{set}->{param}[1]->( $_[0] ), $_[0] );
+        }
+        else 
+        {
+            my $span = DateTime::Span->from_datetimes( before => $_[0] );
+            return _fix_return_datetime(
+                      $self->intersection( $span )->previous, $_[0] );
+        }
+    }
+
+    my ($head, $tail) = $self->{set}->last;
+    $self->{set} = $tail;
+    return $head->max if defined $head;
+    return $head;
+}
+
+# "current" means less-or-equal to a datetime
+sub current {
+    my $self = shift;
+
+    return undef unless ref( $self->{set} );
+
+    if ( $self->{set}->_is_recurrence )
+    {
+        my $tmp = $self->next( $_[0] );
+        return $self->previous( $tmp );
+    }
+
+    return $_[0] if $self->contains( $_[0] );
+    $self->previous( $_[0] );
+}
+
+sub closest {
+    my $self = shift;
+    # return $_[0] if $self->contains( $_[0] );
+    my $dt1 = $self->current( $_[0] );
+    my $dt2 = $self->next( $_[0] );
+
+    return $dt2 unless defined $dt1;
+    return $dt1 unless defined $dt2;
+
+    my $delta = $_[0] - $dt1;
+    return $dt1 if ( $dt2 - $delta ) >= $_[0];
+
+    return $dt2;
+}
+
+sub as_list {
+    my $self = shift;
+    return undef unless ref( $self->{set} );
+
+    my %args = @_;
+    my $span;
+    $span = delete $args{span};
+    $span = DateTime::Span->new( %args ) if %args;
+
+    my $set = $self->clone;
+    $set = $set->intersection( $span ) if $span;
+
+    return if $set->{set}->is_null;  # nothing = empty
+
+    # Note: removing this line means we may end up in an infinite loop!
+    ## return undef if $set->{set}->is_too_complex;  # undef = no begin/end
+ 
+    return undef
+        if $set->max->is_infinite ||
+           $set->min->is_infinite;
+
+    my @result;
+    my $next = $self->min;
+    if ( $span ) {
+        my $next1 = $span->min;
+        $next = $next1 if $next1 && $next1 > $next;
+        $next = $self->current( $next );
+    }
+    my $last = $self->max;
+    if ( $span ) {
+        my $last1 = $span->max;
+        $last = $last1 if $last1 && $last1 < $last;
+    }
+    do {
+        push @result, $next if !$span || $span->contains($next);
+        $next = $self->next( $next );
+    }
+    while $next && $next <= $last;
+    return @result;
+}
+
+sub intersection {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) 
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
+    return $tmp;
+}
+
+sub intersects {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    unless ( $set2->can( 'union' ) )
+    {
+        if ( $set1->{set}->_is_recurrence )
+        {
+            for ( $set2, @_ )
+            {
+                return 1 if $set1->current( $_ ) == $_;
+            }
+            return 0;
+        }
+        $set2 = $class->from_datetimes( dates => [ $set2, @_ ] )
+    }
+    return $set1->{set}->intersects( $set2->{set} );
+}
+
+sub contains {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    unless ( $set2->can( 'union' ) )
+    {
+        if ( $set1->{set}->_is_recurrence )
+        {
+            for ( $set2, @_ ) 
+            {
+                return 0 unless $set1->current( $_ ) == $_;
+            }
+            return 1;
+        }
+        $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) 
+    }
+    return $set1->{set}->contains( $set2->{set} );
+}
+
+sub union {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) 
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->union( $set2->{set} );
+    bless $tmp, 'DateTime::SpanSet' 
+        if $set2->isa('DateTime::Span') or $set2->isa('DateTime::SpanSet');
+    return $tmp;
+}
+
+sub complement {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    if (defined $set2) 
+    {
+        $set2 = $set2->as_set
+            if $set2->can( 'as_set' );
+        $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) 
+            unless $set2->can( 'union' );
+        # TODO: "compose complement";
+        $tmp->{set} = $set1->{set}->complement( $set2->{set} );
+    }
+    else 
+    {
+        $tmp->{set} = $set1->{set}->complement;
+        bless $tmp, 'DateTime::SpanSet';
+    }
+    return $tmp;
+}
+
+sub min { 
+    return _fix_datetime( $_[0]->{set}->min );
+}
+
+sub max { 
+    return _fix_datetime( $_[0]->{set}->max );
+}
+
+# returns a DateTime::Span
+sub span {
+  my $set = $_[0]->{set}->span;
+  my $self = bless { set => $set }, 'DateTime::Span';
+  return $self;
+}
+
+sub count {
+    my ($self) = shift;
+    return undef unless ref( $self->{set} );
+
+    my %args = @_;
+    my $span;
+    $span = delete $args{span};
+    $span = DateTime::Span->new( %args ) if %args;
+
+    my $set = $self->clone;
+    $set = $set->intersection( $span ) if $span;
+
+    return $set->{set}->count
+        unless $set->{set}->is_too_complex;
+
+    return undef
+        if $set->max->is_infinite ||
+           $set->min->is_infinite;
+
+    my $count = 0;
+    my $iter = $set->iterator;
+    $count++ while $iter->next;
+    return $count;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DateTime::Set - Datetime sets and set math
+
+=head1 SYNOPSIS
+
+    use DateTime;
+    use DateTime::Set;
+
+    $date1 = DateTime->new( year => 2002, month => 3, day => 11 );
+    $set1 = DateTime::Set->from_datetimes( dates => [ $date1 ] );
+    #  set1 = 2002-03-11
+
+    $date2 = DateTime->new( year => 2003, month => 4, day => 12 );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $date1, $date2 ] );
+    #  set2 = 2002-03-11, and 2003-04-12
+
+    $date3 = DateTime->new( year => 2003, month => 4, day => 1 );
+    print $set2->next( $date3 )->ymd;      # 2003-04-12
+    print $set2->previous( $date3 )->ymd;  # 2002-03-11
+    print $set2->current( $date3 )->ymd;   # 2002-03-11
+    print $set2->closest( $date3 )->ymd;   # 2003-04-12
+
+    # a 'monthly' recurrence:
+    $set = DateTime::Set->from_recurrence( 
+        recurrence => sub {
+            return $_[0] if $_[0]->is_infinite;
+            return $_[0]->truncate( to => 'month' )->add( months => 1 )
+        },
+        span => $date_span1,    # optional span
+    );
+
+    $set = $set1->union( $set2 );         # like "OR", "insert", "both"
+    $set = $set1->complement( $set2 );    # like "delete", "remove"
+    $set = $set1->intersection( $set2 );  # like "AND", "while"
+    $set = $set1->complement;             # like "NOT", "negate", "invert"
+
+    if ( $set1->intersects( $set2 ) ) { ...  # like "touches", "interferes"
+    if ( $set1->contains( $set2 ) ) { ...    # like "is-fully-inside"
+
+    # data extraction 
+    $date = $set1->min;           # first date of the set
+    $date = $set1->max;           # last date of the set
+
+    $iter = $set1->iterator;
+    while ( $dt = $iter->next ) {
+        print $dt->ymd;
+    };
+
+=head1 DESCRIPTION
+
+DateTime::Set is a module for datetime sets.  It can be used to handle
+two different types of sets.
+
+The first is a fixed set of predefined datetime objects.  For example,
+if we wanted to create a set of datetimes containing the birthdays of
+people in our family for the current year.
+
+The second type of set that it can handle is one based on a
+recurrence, such as "every Wednesday", or "noon on the 15th day of
+every month".  This type of set can have fixed starting and ending
+datetimes, but neither is required.  So our "every Wednesday set"
+could be "every Wednesday from the beginning of time until the end of
+time", or "every Wednesday after 2003-03-05 until the end of time", or
+"every Wednesday between 2003-03-05 and 2004-01-07".
+
+This module also supports set math operations, so you do things like
+create a new set from the union or difference of two sets, check
+whether a datetime is a member of a given set, etc.
+
+This is different from a C<DateTime::Span>, which handles a continuous
+range as opposed to individual datetime points. There is also a module
+C<DateTime::SpanSet> to handle sets of spans.
+
+=head1 METHODS
+
+=over 4
+
+=item * from_datetimes
+
+Creates a new set from a list of datetimes.
+
+   $dates = DateTime::Set->from_datetimes( dates => [ $dt1, $dt2, $dt3 ] );
+
+The datetimes can be objects from class C<DateTime>, or from a
+C<DateTime::Calendar::*> class.
+
+C<DateTime::Infinite::*> objects are not valid set members.
+
+=item * from_recurrence
+
+Creates a new set specified via a "recurrence" callback.
+
+    $months = DateTime::Set->from_recurrence( 
+        span => $dt_span_this_year,    # optional span
+        recurrence => sub { 
+            return $_[0]->truncate( to => 'month' )->add( months => 1 ) 
+        }, 
+    );
+
+The C<span> parameter is optional. It must be a C<DateTime::Span> object.
+
+The span can also be specified using C<begin> / C<after> and C<before>
+/ C<end> parameters, as in the C<DateTime::Span> constructor.  In this
+case, if there is a C<span> parameter it will be ignored.
+
+    $months = DateTime::Set->from_recurrence(
+        after => $dt_now,
+        recurrence => sub {
+            return $_[0]->truncate( to => 'month' )->add( months => 1 );
+        },
+    );
+
+The recurrence function will be passed a single parameter, a datetime
+object. The parameter can be an object from class C<DateTime>, or from
+one of the C<DateTime::Calendar::*> classes.  The parameter can also
+be a C<DateTime::Infinite::Future> or a C<DateTime::Infinite::Past>
+object.
+
+The recurrence must return the I<next> event after that object.  There
+is no guarantee as to what the returned object will be set to, only
+that it will be greater than the object passed to the recurrence.
+
+If there are no more datetimes after the given parameter, then the
+recurrence function should return C<DateTime::Infinite::Future>.
+
+It is ok to modify the parameter C<$_[0]> inside the recurrence
+function.  There are no side-effects.
+
+For example, if you wanted a recurrence that generated datetimes in
+increments of 30 seconds, it would look like this:
+
+  sub every_30_seconds {
+      my $dt = shift;
+      if ( $dt->second < 30 ) {
+          return $dt->truncate( to => 'minute' )->add( seconds => 30 );
+      } else {
+          return $dt->truncate( to => 'minute' )->add( minutes => 1 );
+      }
+  }
+
+Note that this recurrence takes leap seconds into account.  Consider
+using C<truncate()> in this manner to avoid complicated arithmetic
+problems!
+
+It is also possible to create a recurrence by specifying either or both
+of 'next' and 'previous' callbacks.
+
+The callbacks can return C<DateTime::Infinite::Future> and
+C<DateTime::Infinite::Past> objects, in order to define I<bounded
+recurrences>.  In this case, both 'next' and 'previous' callbacks must
+be defined:
+
+    # "monthly from $dt until forever"
+
+    my $months = DateTime::Set->from_recurrence(
+        next => sub {
+            return $dt if $_[0] < $dt;
+            $_[0]->truncate( to => 'month' );
+            $_[0]->add( months => 1 );
+            return $_[0];
+        },
+        previous => sub {
+            my $param = $_[0]->clone;
+            $_[0]->truncate( to => 'month' );
+            $_[0]->subtract( months => 1 ) if $_[0] == $param;
+            return $_[0] if $_[0] >= $dt;
+            return DateTime::Infinite::Past->new;
+        },
+    );
+
+Bounded recurrences are easier to write using C<span> parameters. See above.
+
+See also C<DateTime::Event::Recurrence> and the other
+C<DateTime::Event::*> factory modules for generating specialized
+recurrences, such as sunrise and sunset times, and holidays.
+
+=item * empty_set
+
+Creates a new empty set.
+
+    $set = DateTime::Set->empty_set;
+    print "empty set" unless defined $set->max;
+
+=item * clone
+
+This object method returns a replica of the given object.
+
+C<clone> is useful if you want to apply a transformation to a set,
+but you want to keep the previous value:
+
+    $set2 = $set1->clone;
+    $set2->add_duration( year => 1 );  # $set1 is unaltered
+
+=item * add_duration( $duration )
+
+This method adds the specified duration to every element of the set.
+
+    $dt_dur = new DateTime::Duration( year => 1 );
+    $set->add_duration( $dt_dur );
+
+The original set is modified. If you want to keep the old values use:
+
+    $new_set = $set->clone->add_duration( $dt_dur );
+
+=item * add
+
+This method is syntactic sugar around the C<add_duration()> method.
+
+    $meetings_2004 = $meetings_2003->clone->add( years => 1 );
+
+=item * subtract_duration( $duration_object )
+
+When given a C<DateTime::Duration> object, this method simply calls
+C<invert()> on that object and passes that new duration to the
+C<add_duration> method.
+
+=item * subtract( DateTime::Duration->new parameters )
+
+Like C<add()>, this is syntactic sugar for the C<subtract_duration()>
+method.
+
+=item * set_time_zone( $tz )
+
+This method will attempt to apply the C<set_time_zone> method to every 
+datetime in the set.
+
+=item * set( locale => .. )
+
+This method can be used to change the C<locale> of a datetime set.
+
+=item * min
+
+=item * max
+
+The first and last C<DateTime> in the set.  These methods may return
+C<undef> if the set is empty.  It is also possible that these methods
+may return a C<DateTime::Infinite::Past> or
+C<DateTime::Infinite::Future> object.
+
+These methods return just a I<copy> of the actual boundary value.
+If you modify the result, the set will not be modified.
+
+=item * span
+
+Returns the total span of the set, as a C<DateTime::Span> object.
+
+=item * iterator / next / previous
+
+These methods can be used to iterate over the datetimes in a set.
+
+    $iter = $set1->iterator;
+    while ( $dt = $iter->next ) {
+        print $dt->ymd;
+    }
+
+    # iterate backwards
+    $iter = $set1->iterator;
+    while ( $dt = $iter->previous ) {
+        print $dt->ymd;
+    }
+
+The boundaries of the iterator can be limited by passing it a C<span>
+parameter.  This should be a C<DateTime::Span> object which delimits
+the iterator's boundaries.  Optionally, instead of passing an object,
+you can pass any parameters that would work for one of the
+C<DateTime::Span> class's constructors, and an object will be created
+for you.
+
+Obviously, if the span you specify is not restricted both at the start
+and end, then your iterator may iterate forever, depending on the
+nature of your set.  User beware!
+
+The C<next()> or C<previous()> method will return C<undef> when there
+are no more datetimes in the iterator.
+
+=item * as_list
+
+Returns the set elements as a list of C<DateTime> objects.  Just as
+with the C<iterator()> method, the C<as_list()> method can be limited
+by a span.
+
+  my @dt = $set->as_list( span => $span );
+
+Applying C<as_list()> to a large recurrence set is a very expensive
+operation, both in CPU time and in the memory used.  If you I<really>
+need to extract elements from a large set, you can limit the set with
+a shorter span:
+
+    my @short_list = $large_set->as_list( span => $short_span );
+
+For I<infinite> sets, C<as_list()> will return C<undef>.  Please note
+that this is explicitly not an empty list, since an empty list is a
+valid return value for empty sets!
+
+=item * count
+
+Returns a count of C<DateTime> objects in the set.  Just as with the
+C<iterator()> method, the C<count()> method can be limited by a span.
+
+  defined( my $n = $set->count) or die "can't count";
+
+  my $n = $set->count( span => $span );
+  die "can't count" unless defined $n;
+
+Applying C<count()> to a large recurrence set is a very expensive
+operation, both in CPU time and in the memory used.  If you I<really>
+need to count elements from a large set, you can limit the set with a
+shorter span:
+
+    my $count = $large_set->count( span => $short_span );
+
+For I<infinite> sets, C<count()> will return C<undef>.  Please note
+that this is explicitly not a scalar zero, since a zero count is a
+valid return value for empty sets!
+
+=item * union
+
+=item * intersection
+
+=item * complement
+
+These set operation methods can accept a C<DateTime> list, a
+C<DateTime::Set>, a C<DateTime::Span>, or a C<DateTime::SpanSet>
+object as an argument.
+
+    $set = $set1->union( $set2 );         # like "OR", "insert", "both"
+    $set = $set1->complement( $set2 );    # like "delete", "remove"
+    $set = $set1->intersection( $set2 );  # like "AND", "while"
+    $set = $set1->complement;             # like "NOT", "negate", "invert"
+
+The C<union> of a C<DateTime::Set> with a C<DateTime::Span> or a
+C<DateTime::SpanSet> object returns a C<DateTime::SpanSet> object.
+
+If C<complement> is called without any arguments, then the result is a
+C<DateTime::SpanSet> object representing the spans between each of the
+set's elements.  If complement is given an argument, then the return
+value is a C<DateTime::Set> object representing the I<set difference>
+between the sets.
+
+All other operations will always return a C<DateTime::Set>.
+
+=item * intersects
+
+=item * contains
+
+These set operations result in a boolean value.
+
+    if ( $set1->intersects( $set2 ) ) { ...  # like "touches", "interferes"
+    if ( $set1->contains( $dt ) ) { ...    # like "is-fully-inside"
+
+These methods can accept a C<DateTime> list, a C<DateTime::Set>, a
+C<DateTime::Span>, or a C<DateTime::SpanSet> object as an argument.
+
+=item * previous
+
+=item * next
+
+=item * current
+
+=item * closest
+
+  my $dt = $set->next( $dt );
+  my $dt = $set->previous( $dt );
+  my $dt = $set->current( $dt );
+  my $dt = $set->closest( $dt );
+
+These methods are used to find a set member relative to a given
+datetime.
+
+The C<current()> method returns C<$dt> if $dt is an event, otherwise
+it returns the previous event.
+
+The C<closest()> method returns C<$dt> if $dt is an event, otherwise
+it returns the closest event (previous or next).
+
+All of these methods may return C<undef> if there is no matching
+datetime in the set.
+
+These methods will try to set the returned value to the same time zone
+as the argument, unless the argument has a 'floating' time zone.
+
+=item * map ( sub { ... } )
+
+    # example: remove the hour:minute:second information
+    $set = $set2->map( 
+        sub {
+            return $_->truncate( to => day );
+        }
+    );
+
+    # example: postpone or antecipate events which 
+    #          match datetimes within another set
+    $set = $set2->map(
+        sub {
+            return $_->add( days => 1 ) while $holidays->contains( $_ );
+        }
+    );
+
+This method is the "set" version of Perl "map".
+
+It evaluates a subroutine for each element of the set (locally setting
+"$_" to each datetime) and returns the set composed of the results of
+each such evaluation.
+
+Like Perl "map", each element of the set may produce zero, one, or
+more elements in the returned value.
+
+Unlike Perl "map", changing "$_" does not change the original
+set. This means that calling map in void context has no effect.
+
+The callback subroutine may be called later in the program, due to
+lazy evaluation.  So don't count on subroutine side-effects. For
+example, a C<print> inside the subroutine may happen later than you
+expect.
+
+The callback return value is expected to be within the span of the
+C<previous> and the C<next> element in the original set.  This is a
+limitation of the backtracking algorithm used in the C<Set::Infinite>
+library.
+
+For example: given the set C<[ 2001, 2010, 2015 ]>, the callback
+result for the value C<2010> is expected to be within the span C<[
+2001 .. 2015 ]>.
+
+=item * grep ( sub { ... } )
+
+    # example: filter out any sundays
+    $set = $set2->grep( 
+        sub {
+            return ( $_->day_of_week != 7 );
+        }
+    );
+
+This method is the "set" version of Perl "grep".
+
+It evaluates a subroutine for each element of the set (locally setting
+"$_" to each datetime) and returns the set consisting of those
+elements for which the expression evaluated to true.
+
+Unlike Perl "grep", changing "$_" does not change the original
+set. This means that calling grep in void context has no effect.
+
+Changing "$_" does change the resulting set.
+
+The callback subroutine may be called later in the program, due to
+lazy evaluation.  So don't count on subroutine side-effects. For
+example, a C<print> inside the subroutine may happen later than you
+expect.
+
+=item * iterate ( sub { ... } )
+
+I<deprecated method - please use "map" or "grep" instead.>
+
+=back
+
+=head1 SUPPORT
+
+Support is offered through the C<datetime@perl.org> mailing list.
+
+Please report bugs using rt.cpan.org
+
+=head1 AUTHOR
+
+Flavio Soibelmann Glock <fglock@pucrs.br>
+
+The API was developed together with Dave Rolsky and the DateTime
+Community.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved.
+This program is free software; you can distribute it and/or modify it
+under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file included
+with this module.
+
+=head1 SEE ALSO
+
+Set::Infinite
+
+For details on the Perl DateTime Suite project please see
+L<http://datetime.perl.org>.
+
+=cut
+
diff --git a/modules/fallback/DateTime/Span.pm b/modules/fallback/DateTime/Span.pm
new file mode 100644
index 000000000..5917a8a19
--- /dev/null
+++ b/modules/fallback/DateTime/Span.pm
@@ -0,0 +1,501 @@
+# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package DateTime::Span;
+
+use strict;
+
+use DateTime::Set;
+use DateTime::SpanSet;
+
+use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
+use vars qw( $VERSION );
+
+use constant INFINITY     => DateTime::INFINITY;
+use constant NEG_INFINITY => DateTime::NEG_INFINITY;
+$VERSION = $DateTime::Set::VERSION;
+
+sub set_time_zone {
+    my ( $self, $tz ) = @_;
+
+    $self->{set} = $self->{set}->iterate( 
+        sub {
+            my %tmp = %{ $_[0]->{list}[0] };
+            $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a};
+            $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b};
+            \%tmp;
+        }
+    );
+    return $self;
+}
+
+# note: the constructor must clone its DateTime parameters, such that
+# the set elements become immutable
+sub from_datetimes {
+    my $class = shift;
+    my %args = validate( @_,
+                         { start =>
+                           { type => OBJECT,
+                             optional => 1,
+                           },
+                           end =>
+                           { type => OBJECT,
+                             optional => 1,
+                           },
+                           after =>
+                           { type => OBJECT,
+                             optional => 1,
+                           },
+                           before =>
+                           { type => OBJECT,
+                             optional => 1,
+                           },
+                         }
+                       );
+    my $self = {};
+    my $set;
+
+    die "No arguments given to DateTime::Span->from_datetimes\n"
+        unless keys %args;
+
+    if ( exists $args{start} && exists $args{after} ) {
+        die "Cannot give both start and after arguments to DateTime::Span->from_datetimes\n";
+    }
+    if ( exists $args{end} && exists $args{before} ) {
+        die "Cannot give both end and before arguments to DateTime::Span->from_datetimes\n";
+    }
+
+    my ( $start, $open_start, $end, $open_end );
+    ( $start, $open_start ) = ( NEG_INFINITY,  0 );
+    ( $start, $open_start ) = ( $args{start},  0 ) if exists $args{start};
+    ( $start, $open_start ) = ( $args{after},  1 ) if exists $args{after};
+    ( $end,   $open_end   ) = ( INFINITY,      0 );
+    ( $end,   $open_end   ) = ( $args{end},    0 ) if exists $args{end};
+    ( $end,   $open_end   ) = ( $args{before}, 1 ) if exists $args{before};
+
+    if ( $start > $end ) {
+        die "Span cannot start after the end in DateTime::Span->from_datetimes\n";
+    }
+    $set = Set::Infinite::_recurrence->new( $start, $end );
+    if ( $start != $end ) {
+        # remove start, such that we have ">" instead of ">="
+        $set = $set->complement( $start ) if $open_start;  
+        # remove end, such that we have "<" instead of "<="
+        $set = $set->complement( $end )   if $open_end;    
+    }
+
+    $self->{set} = $set;
+    bless $self, $class;
+    return $self;
+}
+
+sub from_datetime_and_duration {
+    my $class = shift;
+    my %args = @_;
+
+    my $key;
+    my $dt;
+    # extract datetime parameters
+    for ( qw( start end before after ) ) {
+        if ( exists $args{$_} ) {
+           $key = $_;
+           $dt = delete $args{$_};
+       }
+    }
+
+    # extract duration parameters
+    my $dt_duration;
+    if ( exists $args{duration} ) {
+        $dt_duration = $args{duration};
+    }
+    else {
+        $dt_duration = DateTime::Duration->new( %args );
+    }
+    # warn "Creating span from $key => ".$dt->datetime." and $dt_duration";
+    my $other_date = $dt->clone->add_duration( $dt_duration );
+    # warn "Creating span from $key => ".$dt->datetime." and ".$other_date->datetime;
+    my $other_key;
+    if ( $dt_duration->is_positive ) {
+        # check if have to invert keys
+        $key = 'after' if $key eq 'end';
+        $key = 'start' if $key eq 'before';
+        $other_key = 'before';
+    }
+    else {
+        # check if have to invert keys
+        $other_key = 'end' if $key eq 'after';
+        $other_key = 'before' if $key eq 'start';
+        $key = 'start';
+    }
+    return $class->new( $key => $dt, $other_key => $other_date ); 
+}
+
+# This method is intentionally not documented.  It's really only for
+# use by ::Set and ::SpanSet's as_list() and iterator() methods.
+sub new {
+    my $class = shift;
+    my %args = @_;
+
+    # If we find anything _not_ appropriate for from_datetimes, we
+    # assume it must be for durations, and call this constructor.
+    # This way, we don't need to hardcode the DateTime::Duration
+    # parameters.
+    foreach ( keys %args )
+    {
+        return $class->from_datetime_and_duration(%args)
+            unless /^(?:before|after|start|end)$/;
+    }
+
+    return $class->from_datetimes(%args);
+}
+
+sub clone { 
+    bless { 
+        set => $_[0]->{set}->copy,
+        }, ref $_[0];
+}
+
+# Set::Infinite methods
+
+sub intersection {
+    my ($set1, $set2) = @_;
+    my $class = ref($set1);
+    my $tmp = {};  # $class->new();
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
+
+    # intersection() can generate something more complex than a span.
+    bless $tmp, 'DateTime::SpanSet';
+
+    return $tmp;
+}
+
+sub intersects {
+    my ($set1, $set2) = @_;
+    my $class = ref($set1);
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
+        unless $set2->can( 'union' );
+    return $set1->{set}->intersects( $set2->{set} );
+}
+
+sub contains {
+    my ($set1, $set2) = @_;
+    my $class = ref($set1);
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
+        unless $set2->can( 'union' );
+    return $set1->{set}->contains( $set2->{set} );
+}
+
+sub union {
+    my ($set1, $set2) = @_;
+    my $class = ref($set1);
+    my $tmp = {};   # $class->new();
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->union( $set2->{set} );
+ 
+    # union() can generate something more complex than a span.
+    bless $tmp, 'DateTime::SpanSet';
+
+    # # We have to check it's internal structure to find out.
+    # if ( $#{ $tmp->{set}->{list} } != 0 ) {
+    #    bless $tmp, 'Date::SpanSet';
+    # }
+
+    return $tmp;
+}
+
+sub complement {
+    my ($set1, $set2) = @_;
+    my $class = ref($set1);
+    my $tmp = {};   # $class->new;
+    if (defined $set2) {
+        $set2 = $set2->as_spanset
+            if $set2->can( 'as_spanset' );
+        $set2 = $set2->as_set
+            if $set2->can( 'as_set' );
+        $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
+            unless $set2->can( 'union' );
+        $tmp->{set} = $set1->{set}->complement( $set2->{set} );
+    }
+    else {
+        $tmp->{set} = $set1->{set}->complement;
+    }
+
+    # complement() can generate something more complex than a span.
+    bless $tmp, 'DateTime::SpanSet';
+
+    # # We have to check it's internal structure to find out.
+    # if ( $#{ $tmp->{set}->{list} } != 0 ) {
+    #    bless $tmp, 'Date::SpanSet';
+    # }
+
+    return $tmp;
+}
+
+sub start { 
+    return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
+}
+
+*min = \&start;
+
+sub end { 
+    return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
+}
+
+*max = \&end;
+
+sub start_is_open {
+    # min_a returns info about the set boundary 
+    my ($min, $open) = $_[0]->{set}->min_a;
+    return $open;
+}
+
+sub start_is_closed { $_[0]->start_is_open ? 0 : 1 }
+
+sub end_is_open {
+    # max_a returns info about the set boundary 
+    my ($max, $open) = $_[0]->{set}->max_a;
+    return $open;
+}
+
+sub end_is_closed { $_[0]->end_is_open ? 0 : 1 }
+
+
+# span == $self
+sub span { @_ }
+
+sub duration { 
+    my $dur;
+
+    local $@;
+    eval {
+        local $SIG{__DIE__};   # don't want to trap this (rt ticket 5434)
+        $dur = $_[0]->end->subtract_datetime_absolute( $_[0]->start )
+    };
+    
+    return $dur if defined $dur;
+
+    return DateTime::Infinite::Future->new -
+           DateTime::Infinite::Past->new;
+}
+*size = \&duration;
+
+1;
+
+__END__
+
+=head1 NAME
+
+DateTime::Span - Datetime spans
+
+=head1 SYNOPSIS
+
+    use DateTime;
+    use DateTime::Span;
+
+    $date1 = DateTime->new( year => 2002, month => 3, day => 11 );
+    $date2 = DateTime->new( year => 2003, month => 4, day => 12 );
+    $set2 = DateTime::Span->from_datetimes( start => $date1, end => $date2 );
+    #  set2 = 2002-03-11 until 2003-04-12
+
+    $set = $set1->union( $set2 );         # like "OR", "insert", "both"
+    $set = $set1->complement( $set2 );    # like "delete", "remove"
+    $set = $set1->intersection( $set2 );  # like "AND", "while"
+    $set = $set1->complement;             # like "NOT", "negate", "invert"
+
+    if ( $set1->intersects( $set2 ) ) { ...  # like "touches", "interferes"
+    if ( $set1->contains( $set2 ) ) { ...    # like "is-fully-inside"
+
+    # data extraction 
+    $date = $set1->start;           # first date of the span
+    $date = $set1->end;             # last date of the span
+
+=head1 DESCRIPTION
+
+C<DateTime::Span> is a module for handling datetime spans, otherwise
+known as ranges or periods ("from X to Y, inclusive of all datetimes
+in between").
+
+This is different from a C<DateTime::Set>, which is made of individual
+datetime points as opposed to a range. There is also a module
+C<DateTime::SpanSet> to handle sets of spans.
+
+=head1 METHODS
+
+=over 4
+
+=item * from_datetimes
+
+Creates a new span based on a starting and ending datetime.
+
+A 'closed' span includes its end-dates:
+
+   $span = DateTime::Span->from_datetimes( start => $dt1, end => $dt2 );
+
+An 'open' span does not include its end-dates:
+
+   $span = DateTime::Span->from_datetimes( after => $dt1, before => $dt2 );
+
+A 'semi-open' span includes one of its end-dates:
+
+   $span = DateTime::Span->from_datetimes( start => $dt1, before => $dt2 );
+   $span = DateTime::Span->from_datetimes( after => $dt1, end => $dt2 );
+
+A span might have just a beginning date, or just an ending date.
+These spans end, or start, in an imaginary 'forever' date:
+
+   $span = DateTime::Span->from_datetimes( start => $dt1 );
+   $span = DateTime::Span->from_datetimes( end => $dt2 );
+   $span = DateTime::Span->from_datetimes( after => $dt1 );
+   $span = DateTime::Span->from_datetimes( before => $dt2 );
+
+You cannot give both a "start" and "after" argument, nor can you give
+both an "end" and "before" argument.  Either of these conditions will
+cause the C<from_datetimes()> method to die.
+
+To summarize, a datetime passed as either "start" or "end" is included
+in the span.  A datetime passed as either "after" or "before" is
+excluded from the span.
+
+=item * from_datetime_and_duration
+
+Creates a new span.
+
+   $span = DateTime::Span->from_datetime_and_duration( 
+       start => $dt1, duration => $dt_dur1 );
+   $span = DateTime::Span->from_datetime_and_duration( 
+       after => $dt1, hours => 12 );
+
+The new "end of the set" is I<open> by default.
+
+=item * clone
+
+This object method returns a replica of the given object.
+
+=item * set_time_zone( $tz )
+
+This method accepts either a time zone object or a string that can be
+passed as the "name" parameter to C<< DateTime::TimeZone->new() >>.
+If the new time zone's offset is different from the old time zone,
+then the I<local> time is adjusted accordingly.
+
+If the old time zone was a floating time zone, then no adjustments to
+the local time are made, except to account for leap seconds.  If the
+new time zone is floating, then the I<UTC> time is adjusted in order
+to leave the local time untouched.
+
+=item * duration
+
+The total size of the set, as a C<DateTime::Duration> object, or as a
+scalar containing infinity.
+
+Also available as C<size()>.
+
+=item * start
+
+=item * end
+
+First or last dates in the span.
+
+It is possible that the return value from these methods may be a
+C<DateTime::Infinite::Future> or a C<DateTime::Infinite::Past>xs object.
+
+If the set ends C<before> a date C<$dt>, it returns C<$dt>. Note that
+in this case C<$dt> is not a set element - but it is a set boundary.
+
+=cut
+
+# scalar containing either negative infinity
+# or positive infinity.
+
+=item * start_is_closed
+
+=item * end_is_closed
+
+Returns true if the first or last dates belong to the span ( begin <= x <= end ).
+
+=item * start_is_open
+
+=item * end_is_open
+
+Returns true if the first or last dates are excluded from the span ( begin < x < end ).
+
+=item * union
+
+=item * intersection
+
+=item * complement
+
+Set operations may be performed not only with C<DateTime::Span>
+objects, but also with C<DateTime::Set> and C<DateTime::SpanSet>
+objects.  These set operations always return a C<DateTime::SpanSet>
+object.
+
+    $set = $span->union( $set2 );         # like "OR", "insert", "both"
+    $set = $span->complement( $set2 );    # like "delete", "remove"
+    $set = $span->intersection( $set2 );  # like "AND", "while"
+    $set = $span->complement;             # like "NOT", "negate", "invert"
+
+=item * intersects
+
+=item * contains
+
+These set functions return a boolean value.
+
+    if ( $span->intersects( $set2 ) ) { ...  # like "touches", "interferes"
+    if ( $span->contains( $dt ) ) { ...    # like "is-fully-inside"
+
+These methods can accept a C<DateTime>, C<DateTime::Set>,
+C<DateTime::Span>, or C<DateTime::SpanSet> object as an argument.
+
+=back
+
+=head1 SUPPORT
+
+Support is offered through the C<datetime@perl.org> mailing list.
+
+Please report bugs using rt.cpan.org
+
+=head1 AUTHOR
+
+Flavio Soibelmann Glock <fglock@pucrs.br>
+
+The API was developed together with Dave Rolsky and the DateTime Community.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved.
+This program is free software; you can distribute it and/or modify it
+under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file
+included with this module.
+
+=head1 SEE ALSO
+
+Set::Infinite
+
+For details on the Perl DateTime Suite project please see
+L<http://datetime.perl.org>.
+
+=cut
+
diff --git a/modules/fallback/DateTime/SpanSet.pm b/modules/fallback/DateTime/SpanSet.pm
new file mode 100644
index 000000000..8a258f1fb
--- /dev/null
+++ b/modules/fallback/DateTime/SpanSet.pm
@@ -0,0 +1,945 @@
+# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package DateTime::SpanSet;
+
+use strict;
+
+use DateTime::Set;
+use DateTime::Infinite;
+
+use Carp;
+use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
+use vars qw( $VERSION );
+
+use constant INFINITY     =>       100 ** 100 ** 100 ;
+use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
+$VERSION = $DateTime::Set::VERSION;
+
+sub iterate {
+    my ( $self, $callback ) = @_;
+    my $class = ref( $self );
+    my $return = $class->empty_set;
+    $return->{set} = $self->{set}->iterate(
+        sub {
+            my $span = bless { set => $_[0] }, 'DateTime::Span';
+            $callback->( $span->clone );
+            $span = $span->{set} 
+                if UNIVERSAL::can( $span, 'union' );
+            return $span;
+        }
+    );
+    $return;
+}
+
+sub map {
+    my ( $self, $callback ) = @_;
+    my $class = ref( $self );
+    die "The callback parameter to map() must be a subroutine reference"
+        unless ref( $callback ) eq 'CODE';
+    my $return = $class->empty_set;
+    $return->{set} = $self->{set}->iterate( 
+        sub {
+            local $_ = bless { set => $_[0]->clone }, 'DateTime::Span';
+            my @list = $callback->();
+            my $set = $class->empty_set;
+            $set = $set->union( $_ ) for @list;
+            return $set->{set};
+        }
+    );
+    $return;
+}
+
+sub grep {
+    my ( $self, $callback ) = @_;
+    my $class = ref( $self );
+    die "The callback parameter to grep() must be a subroutine reference"
+        unless ref( $callback ) eq 'CODE';
+    my $return = $class->empty_set;
+    $return->{set} = $self->{set}->iterate( 
+        sub {
+            local $_ = bless { set => $_[0]->clone }, 'DateTime::Span';
+            my $result = $callback->();
+            return $_ if $result;
+            return;
+        }
+    );
+    $return;
+}
+
+sub set_time_zone {
+    my ( $self, $tz ) = @_;
+
+    # TODO - use iterate() instead 
+
+    my $result = $self->{set}->iterate( 
+        sub {
+            my %tmp = %{ $_[0]->{list}[0] };
+            $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a};
+            $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b};
+            \%tmp;
+        },
+        backtrack_callback => sub {
+            my ( $min, $max ) = ( $_[0]->min, $_[0]->max );
+            if ( ref($min) )
+            {
+                $min = $min->clone;
+                $min->set_time_zone( 'floating' );
+            }
+            if ( ref($max) )
+            {
+                $max = $max->clone;
+                $max->set_time_zone( 'floating' ); 
+            }
+            return Set::Infinite::_recurrence->new( $min, $max );
+        },
+    );
+
+    ### this code enables 'subroutine method' behaviour
+    $self->{set} = $result;
+    return $self;
+}
+
+sub from_spans {
+    my $class = shift;
+    my %args = validate( @_,
+                         { spans =>
+                           { type => ARRAYREF,
+                             optional => 1,
+                           },
+                         }
+                       );
+    my $self = {};
+    my $set = Set::Infinite::_recurrence->new();
+    $set = $set->union( $_->{set} ) for @{ $args{spans} };
+    $self->{set} = $set;
+    bless $self, $class;
+    return $self;
+}
+
+sub from_set_and_duration {
+    # set => $dt_set, days => 1
+    my $class = shift;
+    my %args = @_;
+    my $set = delete $args{set} || 
+        carp "from_set_and_duration needs a 'set' parameter";
+
+    $set = $set->as_set
+        if UNIVERSAL::can( $set, 'as_set' );
+    unless ( UNIVERSAL::can( $set, 'union' ) ) {
+        carp "'set' must be a set" };
+
+    my $duration = delete $args{duration} ||
+                   new DateTime::Duration( %args );
+    my $end_set = $set->clone->add_duration( $duration );
+    return $class->from_sets( start_set => $set, 
+                              end_set =>   $end_set );
+}
+
+sub from_sets {
+    my $class = shift;
+    my %args = validate( @_,
+                         { start_set =>
+                           { # can => 'union',
+                             optional => 0,
+                           },
+                           end_set =>
+                           { # can => 'union',
+                             optional => 0,
+                           },
+                         }
+                       );
+    my $start_set = delete $args{start_set};
+    my $end_set   = delete $args{end_set};
+
+    $start_set = $start_set->as_set
+        if UNIVERSAL::can( $start_set, 'as_set' );
+    $end_set = $end_set->as_set
+        if UNIVERSAL::can( $end_set, 'as_set' );
+
+    unless ( UNIVERSAL::can( $start_set, 'union' ) ) {
+        carp "'start_set' must be a set" };
+    unless ( UNIVERSAL::can( $end_set, 'union' ) ) {
+        carp "'end_set' must be a set" };
+
+    my $self;
+    $self->{set} = $start_set->{set}->until( 
+                   $end_set->{set} );
+    bless $self, $class;
+    return $self;
+}
+
+sub start_set {
+    if ( exists $_[0]->{set}{method} &&
+         $_[0]->{set}{method} eq 'until' )
+    {
+        return bless { set => $_[0]->{set}{parent}[0] }, 'DateTime::Set';
+    }
+    my $return = DateTime::Set->empty_set;
+    $return->{set} = $_[0]->{set}->start_set;
+    $return;
+}
+
+sub end_set {
+    if ( exists $_[0]->{set}{method} &&
+         $_[0]->{set}{method} eq 'until' )
+    {
+        return bless { set => $_[0]->{set}{parent}[1] }, 'DateTime::Set';
+    }
+    my $return = DateTime::Set->empty_set;
+    $return->{set} = $_[0]->{set}->end_set;
+    $return;
+}
+
+sub empty_set {
+    my $class = shift;
+
+    return bless { set => Set::Infinite::_recurrence->new }, $class;
+}
+
+sub clone { 
+    bless { 
+        set => $_[0]->{set}->copy,
+        }, ref $_[0];
+}
+
+
+sub iterator {
+    my $self = shift;
+
+    my %args = @_;
+    my $span;
+    $span = delete $args{span};
+    $span = DateTime::Span->new( %args ) if %args;
+
+    return $self->intersection( $span ) if $span;
+    return $self->clone;
+}
+
+
+# next() gets the next element from an iterator()
+sub next {
+    my ($self) = shift;
+
+    # TODO: this is fixing an error from elsewhere
+    # - find out what's going on! (with "sunset.pl")
+    return undef unless ref $self->{set};
+
+    if ( @_ )
+    {
+        my $max;
+        $max = $_[0]->max if UNIVERSAL::can( $_[0], 'union' );
+        $max = $_[0] if ! defined $max;
+
+        return undef if ! ref( $max ) && $max == INFINITY;
+
+        my $span = DateTime::Span->from_datetimes( start => $max );
+        my $iterator = $self->intersection( $span );
+        my $return = $iterator->next;
+
+        return $return if ! defined $return;
+        return $return if ! $return->intersects( $max );
+
+        return $iterator->next;
+    }
+
+    my ($head, $tail) = $self->{set}->first;
+    $self->{set} = $tail;
+    return $head unless ref $head;
+    my $return = {
+        set => $head,
+    };
+    bless $return, 'DateTime::Span';
+    return $return;
+}
+
+# previous() gets the last element from an iterator()
+sub previous {
+    my ($self) = shift;
+
+    return undef unless ref $self->{set};
+
+    if ( @_ )
+    {
+        my $min;
+        $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' );
+        $min = $_[0] if ! defined $min;
+
+        return undef if ! ref( $min ) && $min == INFINITY;
+
+        my $span = DateTime::Span->from_datetimes( end => $min );
+        my $iterator = $self->intersection( $span );
+        my $return = $iterator->previous;
+
+        return $return if ! defined $return;
+        return $return if ! $return->intersects( $min );
+
+        return $iterator->previous;
+    }
+
+    my ($head, $tail) = $self->{set}->last;
+    $self->{set} = $tail;
+    return $head unless ref $head;
+    my $return = {
+        set => $head,
+    };
+    bless $return, 'DateTime::Span';
+    return $return;
+}
+
+# "current" means less-or-equal to a DateTime
+sub current {
+    my $self = shift;
+
+    my $previous;
+    my $next;
+    {
+        my $min;
+        $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' );
+        $min = $_[0] if ! defined $min;
+        return undef if ! ref( $min ) && $min == INFINITY;
+        my $span = DateTime::Span->from_datetimes( end => $min );
+        my $iterator = $self->intersection( $span );
+        $previous = $iterator->previous;
+        $span = DateTime::Span->from_datetimes( start => $min );
+        $iterator = $self->intersection( $span );
+        $next = $iterator->next;
+    }
+    return $previous unless defined $next;
+
+    my $dt1 = defined $previous
+        ? $next->union( $previous )
+        : $next;
+
+    my $return = $dt1->intersected_spans( $_[0] );
+
+    $return = $previous
+        if !defined $return->max;
+
+    bless $return, 'DateTime::SpanSet'
+        if defined $return;
+    return $return;
+}
+
+sub closest {
+    my $self = shift;
+    my $dt = shift;
+
+    my $dt1 = $self->current( $dt );
+    my $dt2 = $self->next( $dt );
+    bless $dt2, 'DateTime::SpanSet' 
+        if defined $dt2;
+
+    return $dt2 unless defined $dt1;
+    return $dt1 unless defined $dt2;
+
+    $dt = DateTime::Set->from_datetimes( dates => [ $dt ] )
+        unless UNIVERSAL::can( $dt, 'union' );
+
+    return $dt1 if $dt1->contains( $dt );
+
+    my $delta = $dt->min - $dt1->max;
+    return $dt1 if ( $dt2->min - $delta ) >= $dt->max;
+
+    return $dt2;
+}
+
+sub as_list {
+    my $self = shift;
+    return undef unless ref( $self->{set} );
+
+    my %args = @_;
+    my $span;
+    $span = delete $args{span};
+    $span = DateTime::Span->new( %args ) if %args;
+
+    my $set = $self->clone;
+    $set = $set->intersection( $span ) if $span;
+
+    # Note: removing this line means we may end up in an infinite loop!
+    return undef if $set->{set}->is_too_complex;  # undef = no begin/end
+
+    # return if $set->{set}->is_null;  # nothing = empty
+    my @result;
+    # we should extract _copies_ of the set elements,
+    # such that the user can't modify the set indirectly
+
+    my $iter = $set->iterator;
+    while ( my $dt = $iter->next )
+    {
+        push @result, $dt
+            if ref( $dt );   # we don't want to return INFINITY value
+    };
+
+    return @result;
+}
+
+# Set::Infinite methods
+
+sub intersection {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) 
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
+    return $tmp;
+}
+
+sub intersected_spans {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] )
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->intersected_spans( $set2->{set} );
+    return $tmp;
+}
+
+sub intersects {
+    my ($set1, $set2) = ( shift, shift );
+    
+    unless ( $set2->can( 'union' ) )
+    {
+        for ( $set2, @_ )
+        {
+            return 1 if $set1->contains( $_ );
+        }
+        return 0;
+    }
+    
+    my $class = ref($set1);
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) 
+        unless $set2->can( 'union' );
+    return $set1->{set}->intersects( $set2->{set} );
+}
+
+sub contains {
+    my ($set1, $set2) = ( shift, shift );
+    
+    unless ( $set2->can( 'union' ) )
+    {
+        if ( exists $set1->{set}{method} &&
+             $set1->{set}{method} eq 'until' )
+        {
+            my $start_set = $set1->start_set;
+            my $end_set =   $set1->end_set;
+
+            for ( $set2, @_ )
+            {
+                my $start = $start_set->next( $set2 );
+                my $end =   $end_set->next( $set2 );
+
+                goto ABORT unless defined $start && defined $end;
+            
+                return 0 if $start < $end;
+            }
+            return 1;
+
+            ABORT: ;
+            # don't know 
+        }
+    }
+    
+    my $class = ref($set1);
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) 
+        unless $set2->can( 'union' );
+    return $set1->{set}->contains( $set2->{set} );
+}
+
+sub union {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    $set2 = $set2->as_spanset
+        if $set2->can( 'as_spanset' );
+    $set2 = $set2->as_set
+        if $set2->can( 'as_set' );
+    $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) 
+        unless $set2->can( 'union' );
+    $tmp->{set} = $set1->{set}->union( $set2->{set} );
+    return $tmp;
+}
+
+sub complement {
+    my ($set1, $set2) = ( shift, shift );
+    my $class = ref($set1);
+    my $tmp = $class->empty_set();
+    if (defined $set2) {
+        $set2 = $set2->as_spanset
+            if $set2->can( 'as_spanset' );
+        $set2 = $set2->as_set
+            if $set2->can( 'as_set' );
+        $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) 
+            unless $set2->can( 'union' );
+        $tmp->{set} = $set1->{set}->complement( $set2->{set} );
+    }
+    else {
+        $tmp->{set} = $set1->{set}->complement;
+    }
+    return $tmp;
+}
+
+sub min {
+    return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
+}
+
+sub max { 
+    return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
+}
+
+# returns a DateTime::Span
+sub span { 
+    my $set = $_[0]->{set}->span;
+    my $self = bless { set => $set }, 'DateTime::Span';
+    return $self;
+}
+
+# returns a DateTime::Duration
+sub duration { 
+    my $dur; 
+
+    return DateTime::Duration->new( seconds => 0 ) 
+        if $_[0]->{set}->is_empty;
+
+    local $@;
+    eval { 
+        local $SIG{__DIE__};   # don't want to trap this (rt ticket 5434)
+        $dur = $_[0]->{set}->size 
+    };
+
+    return $dur if defined $dur && ref( $dur );
+    return DateTime::Infinite::Future->new -
+           DateTime::Infinite::Past->new;
+    # return INFINITY;
+}
+*size = \&duration;
+
+1;
+
+__END__
+
+=head1 NAME
+
+DateTime::SpanSet - set of DateTime spans
+
+=head1 SYNOPSIS
+
+    $spanset = DateTime::SpanSet->from_spans( spans => [ $dt_span, $dt_span ] );
+
+    $set = $spanset->union( $set2 );         # like "OR", "insert", "both"
+    $set = $spanset->complement( $set2 );    # like "delete", "remove"
+    $set = $spanset->intersection( $set2 );  # like "AND", "while"
+    $set = $spanset->complement;             # like "NOT", "negate", "invert"
+
+    if ( $spanset->intersects( $set2 ) ) { ...  # like "touches", "interferes"
+    if ( $spanset->contains( $set2 ) ) { ...    # like "is-fully-inside"
+
+    # data extraction 
+    $date = $spanset->min;           # first date of the set
+    $date = $spanset->max;           # last date of the set
+
+    $iter = $spanset->iterator;
+    while ( $dt = $iter->next ) {
+        # $dt is a DateTime::Span
+        print $dt->start->ymd;   # first date of span
+        print $dt->end->ymd;     # last date of span
+    };
+
+=head1 DESCRIPTION
+
+C<DateTime::SpanSet> is a class that represents sets of datetime
+spans.  An example would be a recurring meeting that occurs from
+13:00-15:00 every Friday.
+
+This is different from a C<DateTime::Set>, which is made of individual
+datetime points as opposed to ranges.
+
+=head1 METHODS
+
+=over 4
+
+=item * from_spans
+
+Creates a new span set from one or more C<DateTime::Span> objects.
+
+   $spanset = DateTime::SpanSet->from_spans( spans => [ $dt_span ] );
+
+=item * from_set_and_duration
+
+Creates a new span set from one or more C<DateTime::Set> objects and a
+duration.
+
+The duration can be a C<DateTime::Duration> object, or the parameters
+to create a new C<DateTime::Duration> object, such as "days",
+"months", etc.
+
+   $spanset =
+       DateTime::SpanSet->from_set_and_duration
+           ( set => $dt_set, days => 1 );
+
+=item * from_sets
+
+Creates a new span set from two C<DateTime::Set> objects.
+
+One set defines the I<starting dates>, and the other defines the I<end
+dates>.
+
+   $spanset =
+       DateTime::SpanSet->from_sets
+           ( start_set => $dt_set1, end_set => $dt_set2 );
+
+The spans have the starting date C<closed>, and the end date C<open>,
+like in C<[$dt1, $dt2)>.
+
+If an end date comes without a starting date before it, then it
+defines a span like C<(-inf, $dt)>.
+
+If a starting date comes without an end date after it, then it defines
+a span like C<[$dt, inf)>.
+
+=item * empty_set
+
+Creates a new empty set.
+
+=item * clone
+
+This object method returns a replica of the given object.
+
+=item * set_time_zone( $tz )
+
+This method accepts either a time zone object or a string that can be
+passed as the "name" parameter to C<< DateTime::TimeZone->new() >>.
+If the new time zone's offset is different from the old time zone,
+then the I<local> time is adjusted accordingly.
+
+If the old time zone was a floating time zone, then no adjustments to
+the local time are made, except to account for leap seconds.  If the
+new time zone is floating, then the I<UTC> time is adjusted in order
+to leave the local time untouched.
+
+=item * min
+
+=item * max
+
+First or last dates in the set.  These methods may return C<undef> if
+the set is empty.  It is also possible that these methods may return a
+scalar containing infinity or negative infinity.
+
+=item * duration
+
+The total size of the set, as a C<DateTime::Duration> object.
+
+The duration may be infinite.
+
+Also available as C<size()>.
+
+=item * span
+
+The total span of the set, as a C<DateTime::Span> object.
+
+=item * next 
+
+  my $span = $set->next( $dt );
+
+This method is used to find the next span in the set,
+after a given datetime or span.
+
+The return value is a C<DateTime::Span>, or C<undef> if there is no matching
+span in the set.
+
+=item * previous 
+
+  my $span = $set->previous( $dt );
+
+This method is used to find the previous span in the set,
+before a given datetime or span.
+
+The return value is a C<DateTime::Span>, or C<undef> if there is no matching
+span in the set.
+
+
+=item * current 
+
+  my $span = $set->current( $dt );
+
+This method is used to find the "current" span in the set,
+that intersects a given datetime or span. If no current span
+is found, then the "previous" span is returned.
+
+The return value is a C<DateTime::SpanSet>, or C<undef> if there is no
+matching span in the set.
+
+If a span parameter is given, it may happen that "current" returns
+more than one span.
+
+See also: C<intersected_spans()> method.
+
+=item * closest 
+
+  my $span = $set->closest( $dt );
+
+This method is used to find the "closest" span in the set, given a
+datetime or span.
+
+The return value is a C<DateTime::SpanSet>, or C<undef> if the set is
+empty.
+
+If a span parameter is given, it may happen that "closest" returns
+more than one span.
+
+=item * as_list
+
+Returns a list of C<DateTime::Span> objects.
+
+  my @dt_span = $set->as_list( span => $span );
+
+Just as with the C<iterator()> method, the C<as_list()> method can be
+limited by a span.
+
+Applying C<as_list()> to a large recurring spanset is a very expensive
+operation, both in CPU time and in the memory used.
+
+For this reason, when C<as_list()> operates on large recurrence sets,
+it will return at most approximately 200 spans. For larger sets, and
+for I<infinite> sets, C<as_list()> will return C<undef>.
+
+Please note that this is explicitly not an empty list, since an empty
+list is a valid return value for empty sets!
+
+If you I<really> need to extract spans from a large set, you can:
+
+- limit the set with a shorter span:
+
+    my @short_list = $large_set->as_list( span => $short_span );
+
+- use an iterator:
+
+    my @large_list;
+    my $iter = $large_set->iterator;
+    push @large_list, $dt while $dt = $iter->next;
+
+=item * union
+
+=item * intersection
+
+=item * complement
+
+Set operations may be performed not only with C<DateTime::SpanSet>
+objects, but also with C<DateTime>, C<DateTime::Set> and
+C<DateTime::Span> objects.  These set operations always return a
+C<DateTime::SpanSet> object.
+
+    $set = $spanset->union( $set2 );         # like "OR", "insert", "both"
+    $set = $spanset->complement( $set2 );    # like "delete", "remove"
+    $set = $spanset->intersection( $set2 );  # like "AND", "while"
+    $set = $spanset->complement;             # like "NOT", "negate", "invert"
+
+=item * intersected_spans
+
+This method can accept a C<DateTime> list, a C<DateTime::Set>, a
+C<DateTime::Span>, or a C<DateTime::SpanSet> object as an argument.
+
+    $set = $set1->intersected_spans( $set2 );
+
+The method always returns a C<DateTime::SpanSet> object, containing
+all spans that are intersected by the given set.
+
+Unlike the C<intersection> method, the spans are not modified.  See
+diagram below:
+
+               set1   [....]   [....]   [....]   [....]
+               set2      [................]
+
+       intersection      [.]   [....]   [.]
+
+  intersected_spans   [....]   [....]   [....]
+
+=item * intersects
+
+=item * contains
+
+These set functions return a boolean value.
+
+    if ( $spanset->intersects( $set2 ) ) { ...  # like "touches", "interferes"
+    if ( $spanset->contains( $dt ) ) { ...    # like "is-fully-inside"
+
+These methods can accept a C<DateTime>, C<DateTime::Set>,
+C<DateTime::Span>, or C<DateTime::SpanSet> object as an argument.
+
+=item * iterator / next / previous
+
+This method can be used to iterate over the spans in a set.
+
+    $iter = $spanset->iterator;
+    while ( $dt = $iter->next ) {
+        # $dt is a DateTime::Span
+        print $dt->min->ymd;   # first date of span
+        print $dt->max->ymd;   # last date of span
+    }
+
+The boundaries of the iterator can be limited by passing it a C<span>
+parameter.  This should be a C<DateTime::Span> object which delimits
+the iterator's boundaries.  Optionally, instead of passing an object,
+you can pass any parameters that would work for one of the
+C<DateTime::Span> class's constructors, and an object will be created
+for you.
+
+Obviously, if the span you specify does is not restricted both at the
+start and end, then your iterator may iterate forever, depending on
+the nature of your set.  User beware!
+
+The C<next()> or C<previous()> methods will return C<undef> when there
+are no more spans in the iterator.
+
+=item * start_set
+
+=item * end_set
+
+These methods do the inverse of the C<from_sets> method:
+
+C<start_set> retrieves a DateTime::Set with the start datetime of each
+span.
+
+C<end_set> retrieves a DateTime::Set with the end datetime of each
+span.
+
+=item * map ( sub { ... } )
+
+    # example: enlarge the spans
+    $set = $set2->map( 
+        sub {
+            my $start = $_->start;
+            my $end = $_->end;
+            return DateTime::Span->from_datetimes(
+                start => $start,
+                before => $end,
+            );
+        }
+    );
+
+This method is the "set" version of Perl "map".
+
+It evaluates a subroutine for each element of the set (locally setting
+"$_" to each DateTime::Span) and returns the set composed of the
+results of each such evaluation.
+
+Like Perl "map", each element of the set may produce zero, one, or
+more elements in the returned value.
+
+Unlike Perl "map", changing "$_" does not change the original
+set. This means that calling map in void context has no effect.
+
+The callback subroutine may not be called immediately.  Don't count on
+subroutine side-effects. For example, a C<print> inside the subroutine
+may happen later than you expect.
+
+The callback return value is expected to be within the span of the
+C<previous> and the C<next> element in the original set.
+
+For example: given the set C<[ 2001, 2010, 2015 ]>, the callback
+result for the value C<2010> is expected to be within the span C<[
+2001 .. 2015 ]>.
+
+=item * grep ( sub { ... } )
+
+    # example: filter out all spans happening today
+    my $today = DateTime->today;
+    $set = $set2->grep( 
+        sub {
+            return ( ! $_->contains( $today ) );
+        }
+    );
+
+This method is the "set" version of Perl "grep".
+
+It evaluates a subroutine for each element of the set (locally setting
+"$_" to each DateTime::Span) and returns the set consisting of those
+elements for which the expression evaluated to true.
+
+Unlike Perl "grep", changing "$_" does not change the original
+set. This means that calling grep in void context has no effect.
+
+Changing "$_" does change the resulting set.
+
+The callback subroutine may not be called immediately.  Don't count on
+subroutine side-effects. For example, a C<print> inside the subroutine
+may happen later than you expect.
+
+=item * iterate
+
+I<Internal method - use "map" or "grep" instead.>
+
+This function apply a callback subroutine to all elements of a set and
+returns the resulting set.
+
+The parameter C<$_[0]> to the callback subroutine is a
+C<DateTime::Span> object.
+
+If the callback returns C<undef>, the datetime is removed from the
+set:
+
+    sub remove_sundays {
+        $_[0] unless $_[0]->start->day_of_week == 7;
+    }
+
+The callback return value is expected to be within the span of the
+C<previous> and the C<next> element in the original set.
+
+For example: given the set C<[ 2001, 2010, 2015 ]>, the callback
+result for the value C<2010> is expected to be within the span C<[
+2001 .. 2015 ]>.
+
+The callback subroutine may not be called immediately.  Don't count on
+subroutine side-effects. For example, a C<print> inside the subroutine
+may happen later than you expect.
+
+=back
+
+=head1 SUPPORT
+
+Support is offered through the C<datetime@perl.org> mailing list.
+
+Please report bugs using rt.cpan.org
+
+=head1 AUTHOR
+
+Flavio Soibelmann Glock <fglock@pucrs.br>
+
+The API was developed together with Dave Rolsky and the DateTime Community.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
+This program is free software; you can distribute it and/or
+modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file
+included with this module.
+
+=head1 SEE ALSO
+
+Set::Infinite
+
+For details on the Perl DateTime Suite project please see
+L<http://datetime.perl.org>.
+
+=cut
+
diff --git a/modules/fallback/File/Flock.pm b/modules/fallback/File/Flock.pm
new file mode 100644
index 000000000..f9b62c184
--- /dev/null
+++ b/modules/fallback/File/Flock.pm
@@ -0,0 +1,327 @@
+# Copyright (C) 1996, 1998 David Muir Sharnoff
+
+package File::Flock;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(lock unlock lock_rename);
+
+use Carp;
+use POSIX qw(EAGAIN EACCES EWOULDBLOCK ENOENT EEXIST O_EXCL O_CREAT O_RDWR); 
+use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN);
+use IO::File;
+
+use vars qw($VERSION $debug $av0debug);
+
+BEGIN	{
+	$VERSION = 2008.01;
+	$debug = 0;
+	$av0debug = 0;
+}
+
+use strict;
+no strict qw(refs);
+
+my %locks;		# did we create the file?
+my %lockHandle;
+my %shared;
+my %pid;
+my %rm;
+
+sub new
+{
+	my ($pkg, $file, $shared, $nonblocking) = @_;
+	&lock($file, $shared, $nonblocking) or return undef;
+	return bless \$file, $pkg;
+}
+
+sub DESTROY
+{
+	my ($this) = @_;
+	unlock($$this);
+}
+
+sub lock
+{
+	my ($file, $shared, $nonblocking) = @_;
+
+	my $f = new IO::File;
+
+	my $created = 0;
+	my $previous = exists $locks{$file};
+
+	# the file may be springing in and out of existance...
+	OPEN:
+	for(;;) {
+		if (-e $file) {
+			unless (sysopen($f, $file, O_RDWR)) {
+				redo OPEN if $! == ENOENT;
+				croak "open $file: $!";
+			}
+		} else {
+			unless (sysopen($f, $file, O_CREAT|O_EXCL|O_RDWR)) {
+				redo OPEN if $! == EEXIST;
+				croak "open >$file: $!";
+			}
+			print STDERR " {$$ " if $debug; # }
+			$created = 1;
+		}
+		last;
+	}
+	$locks{$file} = $created || $locks{$file} || 0;
+	$shared{$file} = $shared;
+	$pid{$file} = $$;
+	
+	$lockHandle{$file} = $f;
+
+	my $flags;
+
+	$flags = $shared ? LOCK_SH : LOCK_EX;
+	$flags |= LOCK_NB
+		if $nonblocking;
+	
+	local($0) = "$0 - locking $file" if $av0debug && ! $nonblocking;
+	my $r = flock($f, $flags);
+
+	print STDERR " ($$ " if $debug and $r;
+
+	if ($r) {
+		# let's check to make sure the file wasn't
+		# removed on us!
+
+		my $ifile = (stat($file))[1];
+		my $ihandle;
+		eval { $ihandle = (stat($f))[1] };
+		croak $@ if $@;
+
+		return 1 if defined $ifile 
+			and defined $ihandle 
+			and $ifile == $ihandle;
+
+		# oh well, try again
+		flock($f, LOCK_UN);
+		close($f);
+		return File::Flock::lock($file);
+	}
+
+	return 1 if $r;
+	if ($nonblocking and 
+		(($! == EAGAIN) 
+		or ($! == EACCES)
+		or ($! == EWOULDBLOCK))) 
+	{
+		if (! $previous) {
+			delete $locks{$file};
+			delete $lockHandle{$file};
+			delete $shared{$file};
+			delete $pid{$file};
+		}
+		if ($created) {
+			# oops, a bad thing just happened.  
+			# We don't want to block, but we made the file.
+			&background_remove($f, $file);
+		}
+		close($f);
+		return 0;
+	}
+	croak "flock $f $flags: $!";
+}
+
+#
+# get a lock on a file and remove it if it's empty.  This is to
+# remove files that were created just so that they could be locked.
+#
+# To do this without blocking, defer any files that are locked to the
+# the END block.
+#
+sub background_remove
+{
+	my ($f, $file) = @_;
+
+	if (flock($f, LOCK_EX|LOCK_NB)) {
+		unlink($file)
+			if -s $file == 0;
+		flock($f, LOCK_UN);
+		return 1;
+	} else {
+		$rm{$file} = 1
+			unless exists $rm{$file};
+		return 0;
+	}
+}
+
+sub unlock
+{
+	my ($file) = @_;
+
+	if (ref $file eq 'File::Flock') {
+		bless $file, 'UNIVERSAL'; # avoid destructor later
+		$file = $$file;
+	}
+
+	croak "no lock on $file" unless exists $locks{$file};
+	my $created = $locks{$file};
+	my $unlocked = 0;
+
+
+	my $size = -s $file;
+	if ($created && defined($size) && $size == 0) {
+		if ($shared{$file}) {
+			$unlocked = 
+				&background_remove($lockHandle{$file}, $file);
+		} else { 
+			# {
+			print STDERR " $$} " if $debug;
+			unlink($file) 
+				or croak "unlink $file: $!";
+		}
+	}
+	delete $locks{$file};
+	delete $pid{$file};
+
+	my $f = $lockHandle{$file};
+
+	delete $lockHandle{$file};
+
+	return 0 unless defined $f;
+
+	print STDERR " $$) " if $debug;
+	$unlocked or flock($f, LOCK_UN)
+		or croak "flock $file UN: $!";
+
+	close($f);
+	return 1;
+}
+
+sub lock_rename
+{
+	my ($oldfile, $newfile) = @_;
+
+	if (exists $locks{$newfile}) {
+		unlock $newfile;
+	}
+	delete $locks{$newfile};
+	delete $shared{$newfile};
+	delete $pid{$newfile};
+	delete $lockHandle{$newfile};
+	delete $rm{$newfile};
+
+	$locks{$newfile}	= $locks{$oldfile}	if exists $locks{$oldfile};
+	$shared{$newfile}	= $shared{$oldfile}	if exists $shared{$oldfile};
+	$pid{$newfile}		= $pid{$oldfile}	if exists $pid{$oldfile};
+	$lockHandle{$newfile}	= $lockHandle{$oldfile} if exists $lockHandle{$oldfile};
+	$rm{$newfile}		= $rm{$oldfile}		if exists $rm{$oldfile};
+
+	delete $locks{$oldfile};
+	delete $shared{$oldfile};
+	delete $pid{$oldfile};
+	delete $lockHandle{$oldfile};
+	delete $rm{$oldfile};
+}
+
+#
+# Unlock any files that are still locked and remove any files
+# that were created just so that they could be locked.
+#
+END {
+	my $f;
+	for $f (keys %locks) {
+		&unlock($f)
+			if $pid{$f} == $$;
+	}
+
+	my %bgrm;
+	for my $file (keys %rm) {
+		my $f = new IO::File;
+		if (sysopen($f, $file, O_RDWR)) {
+			if (flock($f, LOCK_EX|LOCK_NB)) {
+				unlink($file)
+					if -s $file == 0;
+				flock($f, LOCK_UN);
+			} else {
+				$bgrm{$file} = 1;
+			}
+			close($f);
+		}
+	}
+	if (%bgrm) {
+		my $ppid = fork;
+		croak "cannot fork" unless defined $ppid;
+		my $pppid = $$;
+		my $b0 = $0;
+		$0 = "$b0: waiting for child ($ppid) to fork()";
+		unless ($ppid) {
+			my $pid = fork;
+			croak "cannot fork" unless defined $pid;
+			unless ($pid) {
+				for my $file (keys %bgrm) {
+					my $f = new IO::File;
+					if (sysopen($f, $file, O_RDWR)) {
+						if (flock($f, LOCK_EX)) {
+							unlink($file)
+								if -s $file == 0;
+							flock($f, LOCK_UN);
+						}
+						close($f);
+					}
+				}
+				print STDERR " $pppid] $pppid)" if $debug;
+			}
+			kill(9, $$); # exit w/o END or anything else
+		}
+		waitpid($ppid, 0);
+		kill(9, $$); # exit w/o END or anything else
+	}
+}
+
+1;
+
+__DATA__
+
+=head1 NAME
+
+ File::Flock - file locking with flock
+
+=head1 SYNOPSIS
+
+ use File::Flock;
+
+ lock($filename);
+
+ lock($filename, 'shared');
+
+ lock($filename, undef, 'nonblocking');
+
+ lock($filename, 'shared', 'nonblocking');
+
+ unlock($filename);
+
+ my $lock = new File::Flock '/somefile';
+
+ lock_rename($oldfilename, $newfilename)
+
+=head1 DESCRIPTION
+
+Lock files using the flock() call.  If the file to be locked does not
+exist, then the file is created.  If the file was created then it will
+be removed when it is unlocked assuming it's still an empty file.
+
+Locks can be created by new'ing a B<File::Flock> object.  Such locks
+are automatically removed when the object goes out of scope.  The
+B<unlock()> method may also be used.
+
+B<lock_rename()> is used to tell File::Flock when a file has been
+renamed (and thus the internal locking data that is stored based
+on the filename should be moved to a new name).  B<unlock()> the
+new name rather than the original name.
+
+=head1 LICENSE
+
+File::Flock may be used/modified/distibuted on the same terms
+as perl itself.  
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.org>
+
+
diff --git a/modules/fallback/Set/Crontab.pm b/modules/fallback/Set/Crontab.pm
new file mode 100644
index 000000000..033d20d2d
--- /dev/null
+++ b/modules/fallback/Set/Crontab.pm
@@ -0,0 +1,160 @@
+# Copyright 2001 Abhijit Menon-Sen <ams@toroid.org>
+
+package Set::Crontab;
+
+use strict;
+use Carp;
+use vars qw( $VERSION );
+
+$VERSION = '1.03';
+
+sub _expand
+{
+    my (@list, @and, @not);
+    my ($self, $spec, $range) = @_;
+
+    # 1,2-4,*/3,!13,>9,<15
+    foreach (split /,/, $spec) {
+        my @pick;
+        my $step = $1 if s#/(\d+)$##;
+
+        # 0+"01" == 1
+        if    (/^(\d+)$/)       { push @pick, 0+$1;          }
+        elsif (/^\*$/)          { push @pick, @$range;       }
+        elsif (/^(\d+)-(\d+)$/) { push @pick, 0+$1..0+$2;    } 
+        elsif (/^!(\d+)$/)      { push @not,  "\$_ != 0+$1"; }
+        elsif (/^([<>])(\d+)$/) { push @and,  "\$_ $1 0+$2"; }
+
+        if ($step) {
+            my $i;
+            @pick = grep { defined $_ if $i++ % $step == 0 } @pick;
+        }
+
+        push @list, @pick;
+    }
+
+    if (@and) {
+        my $and = join q{ && }, @and;
+        push @list, grep { defined $_ if eval $and } @$range;
+    }
+
+    if (@not) {
+        my $not = join q{ && }, @not;
+        @list = grep { defined $_ if eval $not } (@list ? @list : @$range);
+    }
+
+    @list = sort { $a <=> $b } @list;
+    return \@list;
+}
+
+sub _initialise
+{
+    my ($self, $spec, $range) = @_;
+    return undef unless ref($self);
+
+    croak "Usage: ".__PACKAGE__."->new(\$spec, [\@range])"
+        unless defined $spec && ref($range) eq "ARRAY";
+
+    $self->{LIST} = $self->_expand($spec, $range);
+    $self->{HASH} = {map {$_ => 1} @{$self->{LIST}}};
+
+    return $self;
+};
+
+sub new
+{
+    my $class = shift;
+    my $self  = bless {}, ref($class) || $class;
+    return $self->_initialise(@_);
+}
+
+sub contains
+{
+    my ($self, $num) = @_;
+
+    croak "Usage: \$set->contains(\$num)" unless ref($self) && defined $num;
+    return exists $self->{HASH}{$num};
+}
+
+sub list
+{
+    my $self = shift;
+
+    croak "Usage: \$set->list()" unless ref($self);
+    return @{$self->{LIST}};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Set::Crontab - Expand crontab(5)-style integer lists
+
+=head1 SYNOPSIS
+
+$s = Set::Crontab->new("1-9/3,>15,>30,!23", [0..30]);
+
+if ($s->contains(3)) { ... }
+
+=head1 DESCRIPTION
+
+Set::Crontab parses crontab-style lists of integers and defines some
+utility functions to make it easier to deal with them.
+
+=head2 Syntax
+
+Numbers, ranges, *, and step values all work exactly as described in
+L<crontab(5)>. A few extensions to the standard syntax are described
+below.
+
+=over 4
+
+=item < and >
+
+<N selects the elements smaller than N from the entire range, and adds
+them to the set. >N does likewise for elements larger than N.
+
+=item !
+
+!N excludes N from the set. It applies to the other specified 
+range; otherwise it applies to the specified ranges (i.e. "!3" with a
+range of "1-10" corresponds to "1-2,4-10", but ">3,!7" in the same range
+means "4-6,8-10").
+
+=back
+
+=head2 Functions
+
+=over 4
+
+=item new($spec, [@range])
+
+Creates a new Set::Crontab object and returns a reference to it.
+
+=item contains($num)
+
+Returns true if C<$num> exists in the set.
+
+=item list()
+
+Returns the expanded list corresponding to the set. Elements are in
+ascending order.
+
+=back
+
+The functions described above croak if they are called with incorrect
+arguments.
+
+=head1 SEE ALSO
+
+L<crontab(5)>
+
+=head1 AUTHOR
+
+Abhijit Menon-Sen <ams@toroid.org>
+
+Copyright 2001 Abhijit Menon-Sen <ams@toroid.org>
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
diff --git a/modules/fallback/Set/Infinite.pm b/modules/fallback/Set/Infinite.pm
new file mode 100644
index 000000000..72bda52a8
--- /dev/null
+++ b/modules/fallback/Set/Infinite.pm
@@ -0,0 +1,1921 @@
+package Set::Infinite;
+
+# Copyright (c) 2001, 2002, 2003, 2004 Flavio Soibelmann Glock. 
+# All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+use 5.005_03;
+
+# These methods are inherited from Set::Infinite::Basic "as-is":
+#   type list fixtype numeric min max integer real new span copy
+#   start_set end_set universal_set empty_set minus difference
+#   symmetric_difference is_empty
+
+use strict;
+use base qw(Set::Infinite::Basic Exporter);
+use Carp;
+use Set::Infinite::Arithmetic;
+
+use overload
+    '<=>' => \&spaceship,
+    '""'  => \&as_string;
+
+use vars qw(@EXPORT_OK $VERSION 
+    $TRACE $DEBUG_BT $PRETTY_PRINT $inf $minus_inf $neg_inf 
+    %_first %_last %_backtrack
+    $too_complex $backtrack_depth 
+    $max_backtrack_depth $max_intersection_depth
+    $trace_level %level_title );
+
+@EXPORT_OK = qw(inf $inf trace_open trace_close);
+
+$inf     = 100**100**100;
+$neg_inf = $minus_inf  = -$inf;
+
+
+# obsolete methods - included for backward compatibility
+sub inf ()            { $inf }
+sub minus_inf ()      { $minus_inf }
+sub no_cleanup { $_[0] }
+*type       = \&Set::Infinite::Basic::type;
+sub compact { @_ }
+
+
+BEGIN {
+    $VERSION = "0.65";
+    $TRACE = 0;         # enable basic trace method execution
+    $DEBUG_BT = 0;      # enable backtrack tracer
+    $PRETTY_PRINT = 0;  # 0 = print 'Too Complex'; 1 = describe functions
+    $trace_level = 0;   # indentation level when debugging
+
+    $too_complex =    "Too complex";
+    $backtrack_depth = 0;
+    $max_backtrack_depth = 10;    # _backtrack()
+    $max_intersection_depth = 5;  # first()
+}
+
+sub trace { # title=>'aaa'
+    return $_[0] unless $TRACE;
+    my ($self, %parm) = @_;
+    my @caller = caller(1);
+    # print "self $self ". ref($self). "\n";
+    print "" . ( ' | ' x $trace_level ) .
+            "$parm{title} ". $self->copy .
+            ( exists $parm{arg} ? " -- " . $parm{arg}->copy : "" ).
+            " $caller[1]:$caller[2] ]\n" if $TRACE == 1;
+    return $self;
+}
+
+sub trace_open { 
+    return $_[0] unless $TRACE;
+    my ($self, %parm) = @_;
+    my @caller = caller(1);
+    print "" . ( ' | ' x $trace_level ) .
+            "\\ $parm{title} ". $self->copy .
+            ( exists $parm{arg} ? " -- ". $parm{arg}->copy : "" ).
+            " $caller[1]:$caller[2] ]\n";
+    $trace_level++; 
+    $level_title{$trace_level} = $parm{title};
+    return $self;
+}
+
+sub trace_close { 
+    return $_[0] unless $TRACE;
+    my ($self, %parm) = @_;  
+    my @caller = caller(0);
+    print "" . ( ' | ' x ($trace_level-1) ) .
+            "\/ $level_title{$trace_level} ".
+            ( exists $parm{arg} ? 
+               (
+                  defined $parm{arg} ? 
+                      "ret ". ( UNIVERSAL::isa($parm{arg}, __PACKAGE__ ) ? 
+                           $parm{arg}->copy : 
+                           "<$parm{arg}>" ) :
+                      "undef"
+               ) : 
+               ""     # no arg 
+            ).
+            " $caller[1]:$caller[2] ]\n";
+    $trace_level--;
+    return $self;
+}
+
+
+# creates a 'function' object that can be solved by _backtrack()
+sub _function {
+    my ($self, $method) = (shift, shift);
+    my $b = $self->empty_set();
+    $b->{too_complex} = 1;
+    $b->{parent} = $self;   
+    $b->{method} = $method;
+    $b->{param}  = [ @_ ];
+    return $b;
+}
+
+
+# same as _function, but with 2 arguments
+sub _function2 {
+    my ($self, $method, $arg) = (shift, shift, shift);
+    unless ( $self->{too_complex} || $arg->{too_complex} ) {
+        return $self->$method($arg, @_);
+    }
+    my $b = $self->empty_set();
+    $b->{too_complex} = 1;
+    $b->{parent} = [ $self, $arg ];
+    $b->{method} = $method;
+    $b->{param}  = [ @_ ];
+    return $b;
+}
+
+
+sub quantize {
+    my $self = shift;
+    $self->trace_open(title=>"quantize") if $TRACE; 
+    my @min = $self->min_a;
+    my @max = $self->max_a;
+    if (($self->{too_complex}) or 
+        (defined $min[0] && $min[0] == $neg_inf) or 
+        (defined $max[0] && $max[0] == $inf)) {
+
+        return $self->_function( 'quantize', @_ );
+    }
+
+    my @a;
+    my %rule = @_;
+    my $b = $self->empty_set();    
+    my $parent = $self;
+
+    $rule{unit} =   'one' unless $rule{unit};
+    $rule{quant} =  1     unless $rule{quant};
+    $rule{parent} = $parent; 
+    $rule{strict} = $parent unless exists $rule{strict};
+    $rule{type} =   $parent->{type};
+
+    my ($min, $open_begin) = $parent->min_a;
+
+    unless (defined $min) {
+        $self->trace_close( arg => $b ) if $TRACE;
+        return $b;    
+    }
+
+    $rule{fixtype} = 1 unless exists $rule{fixtype};
+    $Set::Infinite::Arithmetic::Init_quantizer{$rule{unit}}->(\%rule);
+
+    $rule{sub_unit} = $Set::Infinite::Arithmetic::Offset_to_value{$rule{unit}};
+    carp "Quantize unit '".$rule{unit}."' not implemented" unless ref( $rule{sub_unit} ) eq 'CODE';
+
+    my ($max, $open_end) = $parent->max_a;
+    $rule{offset} = $Set::Infinite::Arithmetic::Value_to_offset{$rule{unit}}->(\%rule, $min);
+    my $last_offset = $Set::Infinite::Arithmetic::Value_to_offset{$rule{unit}}->(\%rule, $max);
+    $rule{size} = $last_offset - $rule{offset} + 1; 
+    my ($index, $tmp, $this, $next);
+    for $index (0 .. $rule{size} ) {
+        # ($this, $next) = $rule{sub_unit} (\%rule, $index);
+        ($this, $next) = $rule{sub_unit}->(\%rule, $index);
+        unless ( $rule{fixtype} ) {
+                $tmp = { a => $this , b => $next ,
+                        open_begin => 0, open_end => 1 };
+        }
+        else {
+                $tmp = Set::Infinite::Basic::_simple_new($this,$next, $rule{type} );
+                $tmp->{open_end} = 1;
+        }
+        next if ( $rule{strict} and not $rule{strict}->intersects($tmp));
+        push @a, $tmp;
+    }
+
+    $b->{list} = \@a;        # change data
+    $self->trace_close( arg => $b ) if $TRACE;
+    return $b;
+}
+
+
+sub _first_n {
+    my $self = shift;
+    my $n = shift;
+    my $tail = $self->copy;
+    my @result;
+    my $first;
+    for ( 1 .. $n )
+    {
+        ( $first, $tail ) = $tail->first if $tail;
+        push @result, $first;
+    }
+    return $tail, @result;
+}
+
+sub _last_n {
+    my $self = shift;
+    my $n = shift;
+    my $tail = $self->copy;
+    my @result;
+    my $last;
+    for ( 1 .. $n )
+    {
+        ( $last, $tail ) = $tail->last if $tail;
+        unshift @result, $last;
+    }
+    return $tail, @result;
+}
+
+
+sub select {
+    my $self = shift;
+    $self->trace_open(title=>"select") if $TRACE;
+
+    my %param = @_;
+    die "select() - parameter 'freq' is deprecated" if exists $param{freq};
+
+    my $res;
+    my $count;
+    my @by;
+    @by = @{ $param{by} } if exists $param{by}; 
+    $count = delete $param{count} || $inf;
+    # warn "select: count=$count by=[@by]";
+
+    if ($count <= 0) {
+        $self->trace_close( arg => $res ) if $TRACE;
+        return $self->empty_set();
+    }
+
+    my @set;
+    my $tail;
+    my $first;
+    my $last;
+    if ( @by ) 
+    {
+        my @res;
+        if ( ! $self->is_too_complex ) 
+        {
+            $res = $self->new;
+            @res = @{ $self->{list} }[ @by ] ;
+        }
+        else
+        {
+            my ( @pos_by, @neg_by );
+            for ( @by ) {
+                ( $_ < 0 ) ? push @neg_by, $_ :
+                             push @pos_by, $_;
+            }
+            my @first;
+            if ( @pos_by ) {
+                @pos_by = sort { $a <=> $b } @pos_by;
+                ( $tail, @set ) = $self->_first_n( 1 + $pos_by[-1] );
+                @first = @set[ @pos_by ];
+            }
+            my @last;
+            if ( @neg_by ) {
+                @neg_by = sort { $a <=> $b } @neg_by;
+                ( $tail, @set ) = $self->_last_n( - $neg_by[0] );
+                @last = @set[ @neg_by ];
+            }
+            @res = map { $_->{list}[0] } ( @first , @last );
+        }
+
+        $res = $self->new;
+        @res = sort { $a->{a} <=> $b->{a} } grep { defined } @res;
+        my $last;
+        my @a;
+        for ( @res ) {
+            push @a, $_ if ! $last || $last->{a} != $_->{a};
+            $last = $_;
+        }
+        $res->{list} = \@a;
+    }
+    else
+    {
+        $res = $self;
+    }
+
+    return $res if $count == $inf;
+    my $count_set = $self->empty_set();
+    if ( ! $self->is_too_complex )
+    {
+        my @a;
+        @a = grep { defined } @{ $res->{list} }[ 0 .. $count - 1 ] ;
+        $count_set->{list} = \@a;
+    }
+    else
+    {
+        my $last;
+        while ( $res ) {
+            ( $first, $res ) = $res->first;
+            last unless $first;
+            last if $last && $last->{a} == $first->{list}[0]{a};
+            $last = $first->{list}[0];
+            push @{$count_set->{list}}, $first->{list}[0];
+            $count--;
+            last if $count <= 0;
+        }
+    }
+    return $count_set;
+}
+
+BEGIN {
+
+  # %_first and %_last hashes are used to backtrack the value
+  # of first() and last() of an infinite set
+
+  %_first = (
+    'complement' =>
+        sub {
+            my $self = $_[0];
+            my @parent_min = $self->{parent}->first;
+            unless ( defined $parent_min[0] ) {
+                return (undef, 0);
+            }
+            my $parent_complement;
+            my $first;
+            my @next;
+            my $parent;
+            if ( $parent_min[0]->min == $neg_inf ) {
+                my @parent_second = $parent_min[1]->first;
+                #    (-inf..min)        (second..?)
+                #            (min..second)   = complement
+                $first = $self->new( $parent_min[0]->complement );
+                $first->{list}[0]{b} = $parent_second[0]->{list}[0]{a};
+                $first->{list}[0]{open_end} = ! $parent_second[0]->{list}[0]{open_begin};
+                @{ $first->{list} } = () if 
+                    ( $first->{list}[0]{a} == $first->{list}[0]{b}) && 
+                        ( $first->{list}[0]{open_begin} ||
+                          $first->{list}[0]{open_end} );
+                @next = $parent_second[0]->max_a;
+                $parent = $parent_second[1];
+            }
+            else {
+                #            (min..?)
+                #    (-inf..min)        = complement
+                $parent_complement = $parent_min[0]->complement;
+                $first = $self->new( $parent_complement->{list}[0] );
+                @next = $parent_min[0]->max_a;
+                $parent = $parent_min[1];
+            }
+            my @no_tail = $self->new($neg_inf,$next[0]);
+            $no_tail[0]->{list}[0]{open_end} = $next[1];
+            my $tail = $parent->union($no_tail[0])->complement;  
+            return ($first, $tail);
+        },  # end: first-complement
+    'intersection' =>
+        sub {
+            my $self = $_[0];
+            my @parent = @{ $self->{parent} };
+            # warn "$method parents @parent";
+            my $retry_count = 0;
+            my (@first, @min, $which, $first1, $intersection);
+            SEARCH: while ($retry_count++ < $max_intersection_depth) {
+                return undef unless defined $parent[0];
+                return undef unless defined $parent[1];
+                @{$first[0]} = $parent[0]->first;
+                @{$first[1]} = $parent[1]->first;
+                unless ( defined $first[0][0] ) {
+                    # warn "don't know first of $method";
+                    $self->trace_close( arg => 'undef' ) if $TRACE;
+                    return undef;
+                }
+                unless ( defined $first[1][0] ) {
+                    # warn "don't know first of $method";
+                    $self->trace_close( arg => 'undef' ) if $TRACE;
+                    return undef;
+                }
+                @{$min[0]} = $first[0][0]->min_a;
+                @{$min[1]} = $first[1][0]->min_a;
+                unless ( defined $min[0][0] && defined $min[1][0] ) {
+                    return undef;
+                } 
+                # $which is the index to the bigger "first".
+                $which = ($min[0][0] < $min[1][0]) ? 1 : 0;  
+                for my $which1 ( $which, 1 - $which ) {
+                  my $tmp_parent = $parent[$which1];
+                  ($first1, $parent[$which1]) = @{ $first[$which1] };
+                  if ( $first1->is_empty ) {
+                    # warn "first1 empty! count $retry_count";
+                    # trace_close;
+                    # return $first1, undef;
+                    $intersection = $first1;
+                    $which = $which1;
+                    last SEARCH;
+                  }
+                  $intersection = $first1->intersection( $parent[1-$which1] );
+                  # warn "intersection with $first1 is $intersection";
+                  unless ( $intersection->is_null ) { 
+                    # $self->trace( title=>"got an intersection" );
+                    if ( $intersection->is_too_complex ) {
+                        $parent[$which1] = $tmp_parent;
+                    }
+                    else {
+                        $which = $which1;
+                        last SEARCH;
+                    }
+                  };
+                }
+            }
+            if ( $#{ $intersection->{list} } > 0 ) {
+                my $tail;
+                ($intersection, $tail) = $intersection->first;
+                $parent[$which] = $parent[$which]->union( $tail );
+            }
+            my $tmp;
+            if ( defined $parent[$which] and defined $parent[1-$which] ) {
+                $tmp = $parent[$which]->intersection ( $parent[1-$which] );
+            }
+            return ($intersection, $tmp);
+        }, # end: first-intersection
+    'union' =>
+        sub {
+            my $self = $_[0];
+            my (@first, @min);
+            my @parent = @{ $self->{parent} };
+            @{$first[0]} = $parent[0]->first;
+            @{$first[1]} = $parent[1]->first;
+            unless ( defined $first[0][0] ) {
+                # looks like one set was empty
+                return @{$first[1]};
+            }
+            @{$min[0]} = $first[0][0]->min_a;
+            @{$min[1]} = $first[1][0]->min_a;
+
+            # check min1/min2 for undef
+            unless ( defined $min[0][0] ) {
+                $self->trace_close( arg => "@{$first[1]}" ) if $TRACE;
+                return @{$first[1]}
+            }
+            unless ( defined $min[1][0] ) {
+                $self->trace_close( arg => "@{$first[0]}" ) if $TRACE;
+                return @{$first[0]}
+            }
+
+            my $which = ($min[0][0] < $min[1][0]) ? 0 : 1;
+            my $first = $first[$which][0];
+
+            # find out the tail
+            my $parent1 = $first[$which][1];
+            # warn $self->{parent}[$which]." - $first = $parent1";
+            my $parent2 = ($min[0][0] == $min[1][0]) ? 
+                $self->{parent}[1-$which]->complement($first) : 
+                $self->{parent}[1-$which];
+            my $tail;
+            if (( ! defined $parent1 ) || $parent1->is_null) {
+                # warn "union parent1 tail is null"; 
+                $tail = $parent2;
+            }
+            else {
+                my $method = $self->{method};
+                $tail = $parent1->$method( $parent2 );
+            }
+
+            if ( $first->intersects( $tail ) ) {
+                my $first2;
+                ( $first2, $tail ) = $tail->first;
+                $first = $first->union( $first2 );
+            }
+
+            $self->trace_close( arg => "$first $tail" ) if $TRACE;
+            return ($first, $tail);
+        }, # end: first-union
+    'iterate' =>
+        sub {
+            my $self = $_[0];
+            my $parent = $self->{parent};
+            my ($first, $tail) = $parent->first;
+            $first = $first->iterate( @{$self->{param}} ) if ref($first);
+            $tail  = $tail->_function( 'iterate', @{$self->{param}} ) if ref($tail);
+            my $more;
+            ($first, $more) = $first->first if ref($first);
+            $tail = $tail->_function2( 'union', $more ) if defined $more;
+            return ($first, $tail);
+        },
+    'until' =>
+        sub {
+            my $self = $_[0];
+            my ($a1, $b1) = @{ $self->{parent} };
+            $a1->trace( title=>"computing first()" );
+            my @first1 = $a1->first;
+            my @first2 = $b1->first;
+            my ($first, $tail);
+            if ( $first2[0] <= $first1[0] ) {
+                # added ->first because it returns 2 spans if $a1 == $a2
+                $first = $a1->empty_set()->until( $first2[0] )->first;
+                $tail = $a1->_function2( "until", $first2[1] );
+            }
+            else {
+                $first = $a1->new( $first1[0] )->until( $first2[0] );
+                if ( defined $first1[1] ) {
+                    $tail = $first1[1]->_function2( "until", $first2[1] );
+                }
+                else {
+                    $tail = undef;
+                }
+            }
+            return ($first, $tail);
+        },
+    'offset' =>
+        sub {
+            my $self = $_[0];
+            my ($first, $tail) = $self->{parent}->first;
+            $first = $first->offset( @{$self->{param}} );
+            $tail  = $tail->_function( 'offset', @{$self->{param}} );
+            my $more;
+            ($first, $more) = $first->first;
+            $tail = $tail->_function2( 'union', $more ) if defined $more;
+            return ($first, $tail);
+        },
+    'quantize' =>
+        sub {
+            my $self = $_[0];
+            my @min = $self->{parent}->min_a;
+            if ( $min[0] == $neg_inf || $min[0] == $inf ) {
+                return ( $self->new( $min[0] ) , $self->copy );
+            }
+            my $first = $self->new( $min[0] )->quantize( @{$self->{param}} );
+            return ( $first,
+                     $self->{parent}->
+                        _function2( 'intersection', $first->complement )->
+                        _function( 'quantize', @{$self->{param}} ) );
+        },
+    'tolerance' =>
+        sub {
+            my $self = $_[0];
+            my ($first, $tail) = $self->{parent}->first;
+            $first = $first->tolerance( @{$self->{param}} );
+            $tail  = $tail->tolerance( @{$self->{param}} );
+            return ($first, $tail);
+        },
+  );  # %_first
+
+  %_last = (
+    'complement' =>
+        sub {
+            my $self = $_[0];
+            my @parent_max = $self->{parent}->last;
+            unless ( defined $parent_max[0] ) {
+                return (undef, 0);
+            }
+            my $parent_complement;
+            my $last;
+            my @next;
+            my $parent;
+            if ( $parent_max[0]->max == $inf ) {
+                #    (inf..min)        (second..?) = parent
+                #            (min..second)         = complement
+                my @parent_second = $parent_max[1]->last;
+                $last = $self->new( $parent_max[0]->complement );
+                $last->{list}[0]{a} = $parent_second[0]->{list}[0]{b};
+                $last->{list}[0]{open_begin} = ! $parent_second[0]->{list}[0]{open_end};
+                @{ $last->{list} } = () if
+                    ( $last->{list}[0]{a} == $last->{list}[0]{b}) &&
+                        ( $last->{list}[0]{open_end} ||
+                          $last->{list}[0]{open_begin} );
+                @next = $parent_second[0]->min_a;
+                $parent = $parent_second[1];
+            }
+            else {
+                #            (min..?)
+                #    (-inf..min)        = complement
+                $parent_complement = $parent_max[0]->complement;
+                $last = $self->new( $parent_complement->{list}[-1] );
+                @next = $parent_max[0]->min_a;
+                $parent = $parent_max[1];
+            }
+            my @no_tail = $self->new($next[0], $inf);
+            $no_tail[0]->{list}[-1]{open_begin} = $next[1];
+            my $tail = $parent->union($no_tail[-1])->complement;
+            return ($last, $tail);
+        },
+    'intersection' =>
+        sub {
+            my $self = $_[0];
+            my @parent = @{ $self->{parent} };
+            # TODO: check max1/max2 for undef
+
+            my $retry_count = 0;
+            my (@last, @max, $which, $last1, $intersection);
+
+            SEARCH: while ($retry_count++ < $max_intersection_depth) {
+                return undef unless defined $parent[0];
+                return undef unless defined $parent[1];
+
+                @{$last[0]} = $parent[0]->last;
+                @{$last[1]} = $parent[1]->last;
+                unless ( defined $last[0][0] ) {
+                    $self->trace_close( arg => 'undef' ) if $TRACE;
+                    return undef;
+                }
+                unless ( defined $last[1][0] ) {
+                    $self->trace_close( arg => 'undef' ) if $TRACE;
+                    return undef;
+                }
+                @{$max[0]} = $last[0][0]->max_a;
+                @{$max[1]} = $last[1][0]->max_a;
+                unless ( defined $max[0][0] && defined $max[1][0] ) {
+                    $self->trace( title=>"can't find max()" ) if $TRACE;
+                    $self->trace_close( arg => 'undef' ) if $TRACE;
+                    return undef;
+                }
+
+                # $which is the index to the smaller "last".
+                $which = ($max[0][0] > $max[1][0]) ? 1 : 0;
+
+                for my $which1 ( $which, 1 - $which ) {
+                  my $tmp_parent = $parent[$which1];
+                  ($last1, $parent[$which1]) = @{ $last[$which1] };
+                  if ( $last1->is_null ) {
+                    $which = $which1;
+                    $intersection = $last1;
+                    last SEARCH;
+                  }
+                  $intersection = $last1->intersection( $parent[1-$which1] );
+
+                  unless ( $intersection->is_null ) {
+                    # $self->trace( title=>"got an intersection" );
+                    if ( $intersection->is_too_complex ) {
+                        $self->trace( title=>"got a too_complex intersection" ) if $TRACE; 
+                        # warn "too complex intersection";
+                        $parent[$which1] = $tmp_parent;
+                    }
+                    else {
+                        $self->trace( title=>"got an intersection" ) if $TRACE;
+                        $which = $which1;
+                        last SEARCH;
+                    }
+                  };
+                }
+            }
+            $self->trace( title=>"exit loop" ) if $TRACE;
+            if ( $#{ $intersection->{list} } > 0 ) {
+                my $tail;
+                ($intersection, $tail) = $intersection->last;
+                $parent[$which] = $parent[$which]->union( $tail );
+            }
+            my $tmp;
+            if ( defined $parent[$which] and defined $parent[1-$which] ) {
+                $tmp = $parent[$which]->intersection ( $parent[1-$which] );
+            }
+            return ($intersection, $tmp);
+        },
+    'union' =>
+        sub {
+            my $self = $_[0];
+            my (@last, @max);
+            my @parent = @{ $self->{parent} };
+            @{$last[0]} = $parent[0]->last;
+            @{$last[1]} = $parent[1]->last;
+            @{$max[0]} = $last[0][0]->max_a;
+            @{$max[1]} = $last[1][0]->max_a;
+            unless ( defined $max[0][0] ) {
+                return @{$last[1]}
+            }
+            unless ( defined $max[1][0] ) {
+                return @{$last[0]}
+            }
+
+            my $which = ($max[0][0] > $max[1][0]) ? 0 : 1;
+            my $last = $last[$which][0];
+            # find out the tail
+            my $parent1 = $last[$which][1];
+            # warn $self->{parent}[$which]." - $last = $parent1";
+            my $parent2 = ($max[0][0] == $max[1][0]) ?
+                $self->{parent}[1-$which]->complement($last) :
+                $self->{parent}[1-$which];
+            my $tail;
+            if (( ! defined $parent1 ) || $parent1->is_null) {
+                $tail = $parent2;
+            }
+            else {
+                my $method = $self->{method};
+                $tail = $parent1->$method( $parent2 );
+            }
+
+            if ( $last->intersects( $tail ) ) {
+                my $last2;
+                ( $last2, $tail ) = $tail->last;
+                $last = $last->union( $last2 );
+            }
+
+            return ($last, $tail);
+        },
+    'until' =>
+        sub {
+            my $self = $_[0];
+            my ($a1, $b1) = @{ $self->{parent} };
+            $a1->trace( title=>"computing last()" );
+            my @last1 = $a1->last;
+            my @last2 = $b1->last;
+            my ($last, $tail);
+            if ( $last2[0] <= $last1[0] ) {
+                # added ->last because it returns 2 spans if $a1 == $a2
+                $last = $last2[0]->until( $a1 )->last;
+                $tail = $a1->_function2( "until", $last2[1] );
+            }
+            else {
+                $last = $a1->new( $last1[0] )->until( $last2[0] );
+                if ( defined $last1[1] ) {
+                    $tail = $last1[1]->_function2( "until", $last2[1] );
+                }
+                else {
+                    $tail = undef;
+                }
+            }
+            return ($last, $tail);
+        },
+    'iterate' =>
+        sub {
+            my $self = $_[0];
+            my $parent = $self->{parent};
+            my ($last, $tail) = $parent->last;
+            $last = $last->iterate( @{$self->{param}} ) if ref($last);
+            $tail = $tail->_function( 'iterate', @{$self->{param}} ) if ref($tail);
+            my $more;
+            ($last, $more) = $last->last if ref($last);
+            $tail = $tail->_function2( 'union', $more ) if defined $more;
+            return ($last, $tail);
+        },
+    'offset' =>
+        sub {
+            my $self = $_[0];
+            my ($last, $tail) = $self->{parent}->last;
+            $last = $last->offset( @{$self->{param}} );
+            $tail  = $tail->_function( 'offset', @{$self->{param}} );
+            my $more;
+            ($last, $more) = $last->last;
+            $tail = $tail->_function2( 'union', $more ) if defined $more;
+            return ($last, $tail);
+        },
+    'quantize' =>
+        sub {
+            my $self = $_[0];
+            my @max = $self->{parent}->max_a;
+            if (( $max[0] == $neg_inf ) || ( $max[0] == $inf )) {
+                return ( $self->new( $max[0] ) , $self->copy );
+            }
+            my $last = $self->new( $max[0] )->quantize( @{$self->{param}} );
+            if ($max[1]) {  # open_end
+                    if ( $last->min <= $max[0] ) {
+                        $last = $self->new( $last->min - 1e-9 )->quantize( @{$self->{param}} );
+                    }
+            }
+            return ( $last, $self->{parent}->
+                        _function2( 'intersection', $last->complement )->
+                        _function( 'quantize', @{$self->{param}} ) );
+        },
+    'tolerance' =>
+        sub {
+            my $self = $_[0];
+            my ($last, $tail) = $self->{parent}->last;
+            $last = $last->tolerance( @{$self->{param}} );
+            $tail  = $tail->tolerance( @{$self->{param}} );
+            return ($last, $tail);
+        },
+  );  # %_last
+} # BEGIN
+
+sub first {
+    my $self = $_[0];
+    unless ( exists $self->{first} ) {
+        $self->trace_open(title=>"first") if $TRACE;
+        if ( $self->{too_complex} ) {
+            my $method = $self->{method};
+            # warn "method $method ". ( exists $_first{$method} ? "exists" : "does not exist" );
+            if ( exists $_first{$method} ) {
+                @{$self->{first}} = $_first{$method}->($self);
+            }
+            else {
+                my $redo = $self->{parent}->$method ( @{ $self->{param} } );
+                @{$self->{first}} = $redo->first;
+            }
+        }
+        else {
+            return $self->SUPER::first;
+        }
+    }
+    return wantarray ? @{$self->{first}} : $self->{first}[0];
+}
+
+
+sub last {
+    my $self = $_[0];
+    unless ( exists $self->{last} ) {
+        $self->trace(title=>"last") if $TRACE;
+        if ( $self->{too_complex} ) {
+            my $method = $self->{method};
+            if ( exists $_last{$method} ) {
+                @{$self->{last}} = $_last{$method}->($self);
+            }
+            else {
+                my $redo = $self->{parent}->$method ( @{ $self->{param} } );
+                @{$self->{last}} = $redo->last;
+            }
+        }
+        else {
+            return $self->SUPER::last;
+        }
+    }
+    return wantarray ? @{$self->{last}} : $self->{last}[0];
+}
+
+
+# offset: offsets subsets
+sub offset {
+    my $self = shift;
+    if ($self->{too_complex}) {
+        return $self->_function( 'offset', @_ );
+    }
+    $self->trace_open(title=>"offset") if $TRACE;
+
+    my @a;
+    my %param = @_;
+    my $b1 = $self->empty_set();    
+    my ($interval, $ia, $i);
+    $param{mode} = 'offset' unless $param{mode};
+
+    unless (ref($param{value}) eq 'ARRAY') {
+        $param{value} = [0 + $param{value}, 0 + $param{value}];
+    }
+    $param{unit} =    'one'  unless $param{unit};
+    my $parts    =    ($#{$param{value}}) / 2;
+    my $sub_unit =    $Set::Infinite::Arithmetic::subs_offset2{$param{unit}};
+    my $sub_mode =    $Set::Infinite::Arithmetic::_MODE{$param{mode}};
+
+    carp "unknown unit $param{unit} for offset()" unless defined $sub_unit;
+    carp "unknown mode $param{mode} for offset()" unless defined $sub_mode;
+
+    my ($j);
+    my ($cmp, $this, $next, $ib, $part, $open_begin, $open_end, $tmp);
+
+    my @value;
+    foreach $j (0 .. $parts) {
+        push @value, [ $param{value}[$j+$j], $param{value}[$j+$j + 1] ];
+    }
+
+    foreach $interval ( @{ $self->{list} } ) {
+        $ia =         $interval->{a};
+        $ib =         $interval->{b};
+        $open_begin = $interval->{open_begin};
+        $open_end =   $interval->{open_end};
+        foreach $j (0 .. $parts) {
+            # print " [ofs($ia,$ib)] ";
+            ($this, $next) = $sub_mode->( $sub_unit, $ia, $ib, @{$value[$j]} );
+            next if ($this > $next);    # skip if a > b
+            if ($this == $next) {
+                # TODO: fix this
+                $open_end = $open_begin;
+            }
+            push @a, { a => $this , b => $next ,
+                       open_begin => $open_begin , open_end => $open_end };
+        }  # parts
+    }  # self
+    @a = sort { $a->{a} <=> $b->{a} } @a;
+    $b1->{list} = \@a;        # change data
+    $self->trace_close( arg => $b1 ) if $TRACE;
+    $b1 = $b1->fixtype if $self->{fixtype};
+    return $b1;
+}
+
+
+sub is_null {
+    $_[0]->{too_complex} ? 0 : $_[0]->SUPER::is_null;
+}
+
+
+sub is_too_complex {
+    $_[0]->{too_complex} ? 1 : 0;
+}
+
+
+# shows how a 'compacted' set looks like after quantize
+sub _quantize_span {
+    my $self = shift;
+    my %param = @_;
+    $self->trace_open(title=>"_quantize_span") if $TRACE;
+    my $res;
+    if ($self->{too_complex}) {
+        $res = $self->{parent};
+        if ($self->{method} ne 'quantize') {
+            $self->trace( title => "parent is a ". $self->{method} );
+            if ( $self->{method} eq 'union' ) {
+                my $arg0 = $self->{parent}[0]->_quantize_span(%param);
+                my $arg1 = $self->{parent}[1]->_quantize_span(%param);
+                $res = $arg0->union( $arg1 );
+            }
+            elsif ( $self->{method} eq 'intersection' ) {
+                my $arg0 = $self->{parent}[0]->_quantize_span(%param);
+                my $arg1 = $self->{parent}[1]->_quantize_span(%param);
+                $res = $arg0->intersection( $arg1 );
+            }
+
+            # TODO: other methods
+            else {
+                $res = $self; # ->_function( "_quantize_span", %param );
+            }
+            $self->trace_close( arg => $res ) if $TRACE;
+            return $res;
+        }
+
+        # $res = $self->{parent};
+        if ($res->{too_complex}) {
+            $res->trace( title => "parent is complex" );
+            $res = $res->_quantize_span( %param );
+            $res = $res->quantize( @{$self->{param}} )->_quantize_span( %param );
+        }
+        else {
+            $res = $res->iterate (
+                sub {
+                    $_[0]->quantize( @{$self->{param}} )->span;
+                }
+            );
+        }
+    }
+    else {
+        $res = $self->iterate (   sub { $_[0] }   );
+    }
+    $self->trace_close( arg => $res ) if $TRACE;
+    return $res;
+}
+
+
+
+BEGIN {
+
+    %_backtrack = (
+
+        until => sub {
+            my ($self, $arg) = @_;
+            my $before = $self->{parent}[0]->intersection( $neg_inf, $arg->min )->max;
+            $before = $arg->min unless $before;
+            my $after = $self->{parent}[1]->intersection( $arg->max, $inf )->min;
+            $after = $arg->max unless $after;
+            return $arg->new( $before, $after );
+        },
+
+        iterate => sub {
+            my ($self, $arg) = @_;
+
+            if ( defined $self->{backtrack_callback} )
+            {
+                return $arg = $self->new( $self->{backtrack_callback}->( $arg ) );
+            }
+
+            my $before = $self->{parent}->intersection( $neg_inf, $arg->min )->max;
+            $before = $arg->min unless $before;
+            my $after = $self->{parent}->intersection( $arg->max, $inf )->min;
+            $after = $arg->max unless $after;
+
+            return $arg->new( $before, $after );
+        },
+
+        quantize => sub {
+            my ($self, $arg) = @_;
+            if ($arg->{too_complex}) {
+                return $arg;
+            }
+            else {
+                return $arg->quantize( @{$self->{param}} )->_quantize_span;
+            }
+        },
+
+        offset => sub {
+            my ($self, $arg) = @_;
+            # offset - apply offset with negative values
+            my %tmp = @{$self->{param}};
+            my @values = sort @{$tmp{value}};
+
+            my $backtrack_arg2 = $arg->offset( 
+                   unit => $tmp{unit}, 
+                   mode => $tmp{mode}, 
+                   value => [ - $values[-1], - $values[0] ] );
+            return $arg->union( $backtrack_arg2 );   # fixes some problems with 'begin' mode
+        },
+
+    );
+}
+
+
+sub _backtrack {
+    my ($self, $method, $arg) = @_;
+    return $self->$method ($arg) unless $self->{too_complex};
+
+    $self->trace_open( title => 'backtrack '.$self->{method} ) if $TRACE;
+
+    $backtrack_depth++;
+    if ( $backtrack_depth > $max_backtrack_depth ) {
+        carp ( __PACKAGE__ . ": Backtrack too deep " .
+               "(more than $max_backtrack_depth levels)" );
+    }
+
+    if (exists $_backtrack{ $self->{method} } ) {
+        $arg = $_backtrack{ $self->{method} }->( $self, $arg );
+    }
+
+    my $result;
+    if ( ref($self->{parent}) eq 'ARRAY' ) {
+        # has 2 parents (intersection, union, until)
+
+        my ( $result1, $result2 ) = @{$self->{parent}};
+        $result1 = $result1->_backtrack( $method, $arg )
+            if $result1->{too_complex};
+        $result2 = $result2->_backtrack( $method, $arg )
+            if $result2->{too_complex};
+
+        $method = $self->{method};
+        if ( $result1->{too_complex} || $result2->{too_complex} ) {
+            $result = $result1->_function2( $method, $result2 );
+        }
+        else {
+            $result = $result1->$method ($result2);
+        }
+    }
+    else {
+        # has 1 parent and parameters (offset, select, quantize, iterate)
+
+        $result = $self->{parent}->_backtrack( $method, $arg ); 
+        $method = $self->{method};
+        $result = $result->$method ( @{$self->{param}} );
+    }
+
+    $backtrack_depth--;
+    $self->trace_close( arg => $result ) if $TRACE;
+    return $result;
+}
+
+
+sub intersects {
+    my $a1 = shift;
+    my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_);
+
+    $a1->trace(title=>"intersects");
+    if ($a1->{too_complex}) {
+        $a1 = $a1->_backtrack('intersection', $b1 ); 
+    }  # don't put 'else' here
+    if ($b1->{too_complex}) {
+        $b1 = $b1->_backtrack('intersection', $a1);
+    }
+    if (($a1->{too_complex}) or ($b1->{too_complex})) {
+        return undef;   # we don't know the answer!
+    }
+    return $a1->SUPER::intersects( $b1 );
+}
+
+
+sub iterate {
+    my $self = shift;
+    my $callback = shift;
+    die "First argument to iterate() must be a subroutine reference"
+        unless ref( $callback ) eq 'CODE';
+    my $backtrack_callback;
+    if ( @_ && $_[0] eq 'backtrack_callback' )
+    {
+        ( undef, $backtrack_callback ) = ( shift, shift );
+    }
+    my $set;
+    if ($self->{too_complex}) {
+        $self->trace(title=>"iterate:backtrack") if $TRACE;
+        $set = $self->_function( 'iterate', $callback, @_ );
+    }
+    else
+    {
+        $self->trace(title=>"iterate") if $TRACE;
+        $set = $self->SUPER::iterate( $callback, @_ );
+    }
+    $set->{backtrack_callback} = $backtrack_callback;
+    # warn "set backtrack_callback" if defined $backtrack_callback;
+    return $set;
+}
+
+
+sub intersection {
+    my $a1 = shift;
+    my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_);
+
+    $a1->trace_open(title=>"intersection", arg => $b1) if $TRACE;
+    if (($a1->{too_complex}) or ($b1->{too_complex})) {
+        my $arg0 = $a1->_quantize_span;
+        my $arg1 = $b1->_quantize_span;
+        unless (($arg0->{too_complex}) or ($arg1->{too_complex})) {
+            my $res = $arg0->intersection( $arg1 );
+            $a1->trace_close( arg => $res ) if $TRACE;
+            return $res;
+        }
+    }
+    if ($a1->{too_complex}) {
+        $a1 = $a1->_backtrack('intersection', $b1) unless $b1->{too_complex};
+    }  # don't put 'else' here
+    if ($b1->{too_complex}) {
+        $b1 = $b1->_backtrack('intersection', $a1) unless $a1->{too_complex};
+    }
+    if ( $a1->{too_complex} || $b1->{too_complex} ) {
+        $a1->trace_close( ) if $TRACE;
+        return $a1->_function2( 'intersection', $b1 );
+    }
+    return $a1->SUPER::intersection( $b1 );
+}
+
+
+sub intersected_spans {
+    my $a1 = shift;
+    my $b1 = ref ($_[0]) eq ref($a1) ? $_[0] : $a1->new(@_);
+
+    if ($a1->{too_complex}) {
+        $a1 = $a1->_backtrack('intersection', $b1 ) unless $b1->{too_complex};  
+    }  # don't put 'else' here
+    if ($b1->{too_complex}) {
+        $b1 = $b1->_backtrack('intersection', $a1) unless $a1->{too_complex};
+    }
+
+    if ( ! $b1->{too_complex} && ! $a1->{too_complex} )
+    {
+        return $a1->SUPER::intersected_spans ( $b1 );
+    }
+
+    return $b1->iterate(
+        sub {
+            my $tmp = $a1->intersection( $_[0] );
+            return $tmp unless defined $tmp->max;
+
+            my $before = $a1->intersection( $neg_inf, $tmp->min )->last;
+            my $after =  $a1->intersection( $tmp->max, $inf )->first;
+
+            $before = $tmp->union( $before )->first;
+            $after  = $tmp->union( $after )->last;
+
+            $tmp = $tmp->union( $before )
+                if defined $before && $tmp->intersects( $before );
+            $tmp = $tmp->union( $after )
+                if defined $after && $tmp->intersects( $after );
+            return $tmp;
+        }
+    );
+
+}
+
+
+sub complement {
+    my $a1 = shift;
+    # do we have a parameter?
+    if (@_) {
+        my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_);
+
+        $a1->trace_open(title=>"complement", arg => $b1) if $TRACE;
+        $b1 = $b1->complement;
+        my $tmp =$a1->intersection($b1);
+        $a1->trace_close( arg => $tmp ) if $TRACE;
+        return $tmp;
+    }
+    $a1->trace_open(title=>"complement") if $TRACE;
+    if ($a1->{too_complex}) {
+        $a1->trace_close( ) if $TRACE;
+        return $a1->_function( 'complement', @_ );
+    }
+    return $a1->SUPER::complement;
+}
+
+
+sub until {
+    my $a1 = shift;
+    my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_);
+
+    if (($a1->{too_complex}) or ($b1->{too_complex})) {
+        return $a1->_function2( 'until', $b1 );
+    }
+    return $a1->SUPER::until( $b1 );
+}
+
+
+sub union {
+    my $a1 = shift;
+    my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_);  
+    
+    $a1->trace_open(title=>"union", arg => $b1) if $TRACE;
+    if (($a1->{too_complex}) or ($b1->{too_complex})) {
+        $a1->trace_close( ) if $TRACE;
+        return $a1 if $b1->is_null;
+        return $b1 if $a1->is_null;
+        return $a1->_function2( 'union', $b1);
+    }
+    return $a1->SUPER::union( $b1 );
+}
+
+
+# there are some ways to process 'contains':
+# A CONTAINS B IF A == ( A UNION B )
+#    - faster
+# A CONTAINS B IF B == ( A INTERSECTION B )
+#    - can backtrack = works for unbounded sets
+sub contains {
+    my $a1 = shift;
+    $a1->trace_open(title=>"contains") if $TRACE;
+    if ( $a1->{too_complex} ) { 
+        # we use intersection because it is better for backtracking
+        my $b0 = (ref $_[0] eq ref $a1) ? shift : $a1->new(@_);
+        my $b1 = $a1->intersection($b0);
+        if ( $b1->{too_complex} ) {
+            $b1->trace_close( arg => 'undef' ) if $TRACE;
+            return undef;
+        }
+        $a1->trace_close( arg => ($b1 == $b0 ? 1 : 0) ) if $TRACE;
+        return ($b1 == $b0) ? 1 : 0;
+    }
+    my $b1 = $a1->union(@_);
+    if ( $b1->{too_complex} ) {
+        $b1->trace_close( arg => 'undef' ) if $TRACE;
+        return undef;
+    }
+    $a1->trace_close( arg => ($b1 == $a1 ? 1 : 0) ) if $TRACE;
+    return ($b1 == $a1) ? 1 : 0;
+}
+
+
+sub min_a { 
+    my $self = $_[0];
+    return @{$self->{min}} if exists $self->{min};
+    if ($self->{too_complex}) {
+        my @first = $self->first;
+        return @{$self->{min}} = $first[0]->min_a if defined $first[0];
+        return @{$self->{min}} = (undef, 0);
+    }
+    return $self->SUPER::min_a;
+};
+
+
+sub max_a { 
+    my $self = $_[0];
+    return @{$self->{max}} if exists $self->{max};
+    if ($self->{too_complex}) {
+        my @last = $self->last;
+        return @{$self->{max}} = $last[0]->max_a if defined $last[0];
+        return @{$self->{max}} = (undef, 0);
+    }
+    return $self->SUPER::max_a;
+};
+
+
+sub count {
+    my $self = $_[0];
+    # NOTE: subclasses may return "undef" if necessary
+    return $inf if $self->{too_complex};
+    return $self->SUPER::count;
+}
+
+
+sub size { 
+    my $self = $_[0];
+    if ($self->{too_complex}) {
+        my @min = $self->min_a;
+        my @max = $self->max_a;
+        return undef unless defined $max[0] && defined $min[0];
+        return $max[0] - $min[0];
+    }
+    return $self->SUPER::size;
+};
+
+
+sub spaceship {
+    my ($tmp1, $tmp2, $inverted) = @_;
+    carp "Can't compare unbounded sets" 
+        if $tmp1->{too_complex} or $tmp2->{too_complex};
+    return $tmp1->SUPER::spaceship( $tmp2, $inverted );
+}
+
+
+sub _cleanup { @_ }    # this subroutine is obsolete
+
+
+sub tolerance {
+    my $self = shift;
+    my $tmp = pop;
+    if (ref($self)) {  
+        # local
+        return $self->{tolerance} unless defined $tmp;
+        if ($self->{too_complex}) {
+            my $b1 = $self->_function( 'tolerance', $tmp );
+            $b1->{tolerance} = $tmp;   # for max/min processing
+            return $b1;
+        }
+        return $self->SUPER::tolerance( $tmp );
+    }
+    # class method
+    __PACKAGE__->SUPER::tolerance( $tmp ) if defined($tmp);
+    return __PACKAGE__->SUPER::tolerance;   
+}
+
+
+sub _pretty_print {
+    my $self = shift;
+    return "$self" unless $self->{too_complex};
+    return $self->{method} . "( " .
+               ( ref($self->{parent}) eq 'ARRAY' ? 
+                   $self->{parent}[0] . ' ; ' . $self->{parent}[1] : 
+                   $self->{parent} ) .
+           " )";
+}
+
+
+sub as_string {
+    my $self = shift;
+    return ( $PRETTY_PRINT ? $self->_pretty_print : $too_complex ) 
+        if $self->{too_complex};
+    return $self->SUPER::as_string;
+}
+
+
+sub DESTROY {}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Set::Infinite - Sets of intervals
+
+
+=head1 SYNOPSIS
+
+  use Set::Infinite;
+
+  $set = Set::Infinite->new(1,2);    # [1..2]
+  print $set->union(5,6);            # [1..2],[5..6]
+
+
+=head1 DESCRIPTION
+
+Set::Infinite is a Set Theory module for infinite sets.
+
+A set is a collection of objects. 
+The objects that belong to a set are called its members, or "elements". 
+
+As objects we allow (almost) anything:  reals, integers, and objects (such as dates).
+
+We allow sets to be infinite.
+
+There is no account for the order of elements. For example, {1,2} = {2,1}.
+
+There is no account for repetition of elements. For example, {1,2,2} = {1,1,1,2} = {1,2}.
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+Creates a new set object:
+
+    $set = Set::Infinite->new;             # empty set
+    $set = Set::Infinite->new( 10 );       # single element
+    $set = Set::Infinite->new( 10, 20 );   # single range
+    $set = Set::Infinite->new( 
+              [ 10, 20 ], [ 50, 70 ] );    # two ranges
+
+=over 4
+
+=item empty set
+
+    $set = Set::Infinite->new;
+
+=item set with a single element
+
+    $set = Set::Infinite->new( 10 );
+
+    $set = Set::Infinite->new( [ 10 ] );
+
+=item set with a single span
+
+    $set = Set::Infinite->new( 10, 20 );
+
+    $set = Set::Infinite->new( [ 10, 20 ] );
+    # 10 <= x <= 20
+
+=item set with a single, open span
+
+    $set = Set::Infinite->new(
+        {
+            a => 10, open_begin => 0,
+            b => 20, open_end => 1,
+        }
+    );
+    # 10 <= x < 20
+
+=item set with multiple spans
+
+    $set = Set::Infinite->new( 10, 20,  100, 200 );
+
+    $set = Set::Infinite->new( [ 10, 20 ], [ 100, 200 ] );
+
+    $set = Set::Infinite->new(
+        {
+            a => 10, open_begin => 0,
+            b => 20, open_end => 0,
+        },
+        {
+            a => 100, open_begin => 0,
+            b => 200, open_end => 0,
+        }
+    );
+
+=back
+
+The C<new()> method expects I<ordered> parameters.
+
+If you have unordered ranges, you can build the set using C<union>:
+
+    @ranges = ( [ 10, 20 ], [ -10, 1 ] );
+    $set = Set::Infinite->new;
+    $set = $set->union( @$_ ) for @ranges;
+
+The data structures passed to C<new> must be I<immutable>.
+So this is not good practice:
+
+    $set = Set::Infinite->new( $object_a, $object_b );
+    $object_a->set_value( 10 );
+
+This is the recommended way to do it:
+
+    $set = Set::Infinite->new( $object_a->clone, $object_b->clone );
+    $object_a->set_value( 10 );
+
+
+=head2 clone / copy
+
+Creates a new object, and copy the object data.
+
+=head2 empty_set
+
+Creates an empty set.
+
+If called from an existing set, the empty set inherits
+the "type" and "density" characteristics.
+
+=head2 universal_set
+
+Creates a set containing "all" possible elements.
+
+If called from an existing set, the universal set inherits
+the "type" and "density" characteristics.
+
+=head1 SET FUNCTIONS
+
+=head2 union
+
+    $set = $set->union($b);
+
+Returns the set of all elements from both sets.
+
+This function behaves like an "OR" operation.
+
+    $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] );
+    $set2 = new Set::Infinite( [ 7, 20 ] );
+    print $set1->union( $set2 );
+    # output: [1..4],[7..20]
+
+=head2 intersection
+
+    $set = $set->intersection($b);
+
+Returns the set of elements common to both sets.
+
+This function behaves like an "AND" operation.
+
+    $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] );
+    $set2 = new Set::Infinite( [ 7, 20 ] );
+    print $set1->intersection( $set2 );
+    # output: [8..12]
+
+=head2 complement
+
+=head2 minus
+
+=head2 difference
+
+    $set = $set->complement;
+
+Returns the set of all elements that don't belong to the set.
+
+    $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] );
+    print $set1->complement;
+    # output: (-inf..1),(4..8),(12..inf)
+
+The complement function might take a parameter:
+
+    $set = $set->minus($b);
+
+Returns the set-difference, that is, the elements that don't
+belong to the given set.
+
+    $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] );
+    $set2 = new Set::Infinite( [ 7, 20 ] );
+    print $set1->minus( $set2 );
+    # output: [1..4]
+
+=head2 symmetric_difference
+
+Returns a set containing elements that are in either set,
+but not in both. This is the "set" version of "XOR".
+
+=head1 DENSITY METHODS    
+
+=head2 real
+
+    $set1 = $set->real;
+
+Returns a set with density "0".
+
+=head2 integer
+
+    $set1 = $set->integer;
+
+Returns a set with density "1".
+
+=head1 LOGIC FUNCTIONS
+
+=head2 intersects
+
+    $logic = $set->intersects($b);
+
+=head2 contains
+
+    $logic = $set->contains($b);
+
+=head2 is_empty
+
+=head2 is_null
+
+    $logic = $set->is_null;
+
+=head2 is_nonempty 
+
+This set that has at least 1 element.
+
+=head2 is_span 
+
+This set that has a single span or interval.
+
+=head2 is_singleton
+
+This set that has a single element.
+
+=head2 is_subset( $set )
+
+Every element of this set is a member of the given set.
+
+=head2 is_proper_subset( $set )
+
+Every element of this set is a member of the given set.
+Some members of the given set are not elements of this set.
+
+=head2 is_disjoint( $set )
+
+The given set has no elements in common with this set.
+
+=head2 is_too_complex
+
+Sometimes a set might be too complex to enumerate or print.
+
+This happens with sets that represent infinite recurrences, such as
+when you ask for a quantization on a
+set bounded by -inf or inf.
+
+See also: C<count> method.
+
+=head1 SCALAR FUNCTIONS
+
+=head2 min
+
+    $i = $set->min;
+
+=head2 max
+
+    $i = $set->max;
+
+=head2 size
+
+    $i = $set->size;  
+
+=head2 count
+
+    $i = $set->count;
+
+=head1 OVERLOADED OPERATORS
+
+=head2 stringification
+
+    print $set;
+
+    $str = "$set";
+
+See also: C<as_string>.
+
+=head2 comparison
+
+    sort
+
+    > < == >= <= <=> 
+
+See also: C<spaceship> method.
+
+=head1 CLASS METHODS
+
+    Set::Infinite->separators(@i)
+
+        chooses the interval separators for stringification. 
+
+        default are [ ] ( ) '..' ','.
+
+    inf
+
+        returns an 'Infinity' number.
+
+    minus_inf
+
+        returns '-Infinity' number.
+
+=head2 type
+
+    type( "My::Class::Name" )
+
+Chooses a default object data type.
+
+Default is none (a normal Perl SCALAR).
+
+
+=head1 SPECIAL SET FUNCTIONS
+
+=head2 span
+
+    $set1 = $set->span;
+
+Returns the set span.
+
+=head2 until
+
+Extends a set until another:
+
+    0,5,7 -> until 2,6,10
+
+gives
+
+    [0..2), [5..6), [7..10)
+
+=head2 start_set
+
+=head2 end_set
+
+These methods do the inverse of the "until" method.
+
+Given:
+
+    [0..2), [5..6), [7..10)
+
+start_set is:
+
+    0,5,7
+
+end_set is:
+
+    2,6,10
+
+=head2 intersected_spans
+
+    $set = $set1->intersected_spans( $set2 );
+
+The method returns a new set,
+containing all spans that are intersected by the given set.
+
+Unlike the C<intersection> method, the spans are not modified.
+See diagram below:
+
+               set1   [....]   [....]   [....]   [....]
+               set2      [................]
+
+       intersection      [.]   [....]   [.]
+
+  intersected_spans   [....]   [....]   [....]
+
+
+=head2 quantize
+
+    quantize( parameters )
+
+        Makes equal-sized subsets.
+
+        Returns an ordered set of equal-sized subsets.
+
+        Example: 
+
+            $set = Set::Infinite->new([1,3]);
+            print join (" ", $set->quantize( quant => 1 ) );
+
+        Gives: 
+
+            [1..2) [2..3) [3..4)
+
+=head2 select
+
+    select( parameters )
+
+Selects set spans based on their ordered positions
+
+C<select> has a behaviour similar to an array C<slice>.
+
+            by       - default=All
+            count    - default=Infinity
+
+ 0  1  2  3  4  5  6  7  8      # original set
+ 0  1  2                        # count => 3 
+    1              6            # by => [ -2, 1 ]
+
+=head2 offset
+
+    offset ( parameters )
+
+Offsets the subsets. Parameters: 
+
+    value   - default=[0,0]
+    mode    - default='offset'. Possible values are: 'offset', 'begin', 'end'.
+    unit    - type of value. Can be 'days', 'weeks', 'hours', 'minutes', 'seconds'.
+
+=head2 iterate
+
+    iterate ( sub { } , @args )
+
+Iterates on the set spans, over a callback subroutine. 
+Returns the union of all partial results.
+
+The callback argument C<$_[0]> is a span. If there are additional arguments they are passed to the callback.
+
+The callback can return a span, a hashref (see C<Set::Infinite::Basic>), a scalar, an object, or C<undef>.
+
+[EXPERIMENTAL]
+C<iterate> accepts an optional C<backtrack_callback> argument. 
+The purpose of the C<backtrack_callback> is to I<reverse> the
+iterate() function, overcoming the limitations of the internal
+backtracking algorithm.
+The syntax is:
+
+    iterate ( sub { } , backtrack_callback => sub { }, @args )
+
+The C<backtrack_callback> can return a span, a hashref, a scalar, 
+an object, or C<undef>. 
+
+For example, the following snippet adds a constant to each
+element of an unbounded set:
+
+    $set1 = $set->iterate( 
+                 sub { $_[0]->min + 54, $_[0]->max + 54 }, 
+              backtrack_callback =>  
+                 sub { $_[0]->min - 54, $_[0]->max - 54 }, 
+              );
+
+=head2 first / last
+
+    first / last
+
+In scalar context returns the first or last interval of a set.
+
+In list context returns the first or last interval of a set, 
+and the remaining set (the 'tail').
+
+See also: C<min>, C<max>, C<min_a>, C<max_a> methods.
+
+=head2 type
+
+    type( "My::Class::Name" )
+
+Chooses a default object data type. 
+
+default is none (a normal perl SCALAR).
+
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 _backtrack
+
+    $set->_backtrack( 'intersection', $b );
+
+Internal function to evaluate recurrences.
+
+=head2 numeric
+
+    $set->numeric;
+
+Internal function to ignore the set "type".
+It is used in some internal optimizations, when it is
+possible to use scalar values instead of objects.
+
+=head2 fixtype
+
+    $set->fixtype;
+
+Internal function to fix the result of operations
+that use the numeric() function.
+
+=head2 tolerance
+
+    $set = $set->tolerance(0)    # defaults to real sets (default)
+    $set = $set->tolerance(1)    # defaults to integer sets
+
+Internal function for changing the set "density".
+
+=head2 min_a
+
+    ($min, $min_is_open) = $set->min_a;
+
+=head2 max_a
+
+    ($max, $max_is_open) = $set->max_a;
+
+
+=head2 as_string
+
+Implements the "stringification" operator.
+
+Stringification of unbounded recurrences is not implemented.
+
+Unbounded recurrences are stringified as "function descriptions",
+if the class variable $PRETTY_PRINT is set.
+
+=head2 spaceship
+
+Implements the "comparison" operator.
+
+Comparison of unbounded recurrences is not implemented.
+
+
+=head1 CAVEATS
+
+=over 4
+
+=item * constructor "span" notation
+
+    $set = Set::Infinite->new(10,1);
+
+Will be interpreted as [1..10]
+
+=item * constructor "multiple-span" notation
+
+    $set = Set::Infinite->new(1,2,3,4);
+
+Will be interpreted as [1..2],[3..4] instead of [1,2,3,4].
+You probably want ->new([1],[2],[3],[4]) instead,
+or maybe ->new(1,4) 
+
+=item * "range operator"
+
+    $set = Set::Infinite->new(1..3);
+
+Will be interpreted as [1..2],3 instead of [1,2,3].
+You probably want ->new(1,3) instead.
+
+=back
+
+=head1 INTERNALS
+
+The base I<set> object, without recurrences, is a C<Set::Infinite::Basic>.
+
+A I<recurrence-set> is represented by a I<method name>, 
+one or two I<parent objects>, and extra arguments.
+The C<list> key is set to an empty array, and the
+C<too_complex> key is set to C<1>.
+
+This is a structure that holds the union of two "complex sets":
+
+  {
+    too_complex => 1,             # "this is a recurrence"
+    list   => [ ],                # not used
+    method => 'union',            # function name
+    parent => [ $set1, $set2 ],   # "leaves" in the syntax-tree
+    param  => [ ]                 # optional arguments for the function
+  }
+
+This is a structure that holds the complement of a "complex set":
+
+  {
+    too_complex => 1,             # "this is a recurrence"
+    list   => [ ],                # not used
+    method => 'complement',       # function name
+    parent => $set,               # "leaf" in the syntax-tree
+    param  => [ ]                 # optional arguments for the function
+  }
+
+
+=head1 SEE ALSO
+
+See modules DateTime::Set, DateTime::Event::Recurrence, 
+DateTime::Event::ICal, DateTime::Event::Cron
+for up-to-date information on date-sets.
+
+The perl-date-time project <http://datetime.perl.org> 
+
+
+=head1 AUTHOR
+
+Flavio S. Glock <fglock@gmail.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003 Flavio Soibelmann Glock.  All rights reserved.  
+This program is free software; you can redistribute it and/or modify 
+it under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file included
+with this module.
+
+=cut
+
diff --git a/modules/fallback/Set/Infinite/Arithmetic.pm b/modules/fallback/Set/Infinite/Arithmetic.pm
new file mode 100644
index 000000000..e1a05c5ae
--- /dev/null
+++ b/modules/fallback/Set/Infinite/Arithmetic.pm
@@ -0,0 +1,367 @@
+package Set::Infinite::Arithmetic;
+# Copyright (c) 2001 Flavio Soibelmann Glock. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+use strict;
+# use warnings;
+require Exporter;
+use Carp;
+use Time::Local;
+use POSIX qw(floor);
+
+use vars qw( @EXPORT @EXPORT_OK $inf );
+
+@EXPORT = qw();
+@EXPORT_OK = qw();
+# @EXPORT_OK = qw( %subs_offset2 %Offset_to_value %Value_to_offset %Init_quantizer );
+
+$inf = 100**100**100;    # $Set::Infinite::inf;  doesn't work! (why?)
+
+=head2 NAME
+
+Set::Infinite::Arithmetic - Scalar operations used by quantize() and offset()
+
+=head2 AUTHOR
+
+Flavio Soibelmann Glock - fglock@pucrs.br
+
+=cut
+
+use vars qw( $day_size $hour_size $minute_size $second_size ); 
+$day_size =    timegm(0,0,0,2,3,2001) - timegm(0,0,0,1,3,2001);
+$hour_size =   $day_size / 24;
+$minute_size = $hour_size / 60;
+$second_size = $minute_size / 60;
+
+use vars qw( %_MODE %subs_offset2 %Offset_to_value @week_start %Init_quantizer %Value_to_offset %Offset_to_value );
+
+=head2 %_MODE hash of subs
+
+    $a->offset ( value => [1,2], mode => 'offset', unit => 'days' );
+
+    $a->offset ( value => [1,2, -5,-4], mode => 'offset', unit => 'days' );
+
+note: if mode = circle, then "-5" counts from end (like a Perl negative array index).
+
+    $a->offset ( value => [1,2], mode => 'offset', unit => 'days', strict => $a );
+
+option 'strict' will return intersection($a,offset). Default: none.
+
+=cut
+
+# return value = ($this, $next, $cmp)
+%_MODE = (
+    circle => sub {
+            if ($_[3] >= 0) {
+                &{ $_[0] } ($_[1], $_[3], $_[4] ) 
+            }
+            else {
+                &{ $_[0] } ($_[2], $_[3], $_[4] ) 
+            }
+    },
+    begin =>  sub { &{ $_[0] } ($_[1], $_[3], $_[4] ) },
+    end =>    sub { &{ $_[0] } ($_[2], $_[3], $_[4] ) },
+    offset => sub {
+            my ($this, undef) = &{ $_[0] } ($_[1], $_[3], $_[4] );
+            my (undef, $next) = &{ $_[0] } ($_[2], $_[3], $_[4] );
+            ($this, $next); 
+    }
+);
+
+
+=head2 %subs_offset2($object, $offset1, $offset2)
+
+    &{ $subs_offset2{$unit} } ($object, $offset1, $offset2);
+
+A hash of functions that return:
+
+    ($object+$offset1, $object+$offset2)
+
+in $unit context.
+
+Returned $object+$offset1, $object+$offset2 may be scalars or objects.
+
+=cut
+
+%subs_offset2 = (
+    weekdays =>    sub {
+        # offsets to week-day specified
+        # 0 = first sunday from today (or today if today is sunday)
+        # 1 = first monday from today (or today if today is monday)
+        # 6 = first friday from today (or today if today is friday)
+        # 13 = second friday from today 
+        # -1 = last saturday from today (not today, even if today were saturday)
+        # -2 = last friday
+        my ($self, $index1, $index2) = @_;
+        return ($self, $self) if $self == $inf;
+        # my $class = ref($self);
+        my @date = gmtime( $self ); 
+        my $wday = $date[6];
+        my ($tmp1, $tmp2);
+
+        $tmp1 = $index1 - $wday;
+        if ($index1 >= 0) { 
+            $tmp1 += 7 if $tmp1 < 0; # it will only happen next week 
+        }
+        else {
+            $tmp1 += 7 if $tmp1 < -7; # if will happen this week
+        } 
+
+        $tmp2 = $index2 - $wday;
+        if ($index2 >= 0) { 
+            $tmp2 += 7 if $tmp2 < 0; # it will only happen next week 
+        }
+        else {
+            $tmp2 += 7 if $tmp2 < -7; # if will happen this week
+        } 
+
+        # print " [ OFS:weekday $self $tmp1 $tmp2 ] \n";
+        # $date[3] += $tmp1;
+        $tmp1 = $self + $tmp1 * $day_size;
+        # $date[3] += $tmp2 - $tmp1;
+        $tmp2 = $self + $tmp2 * $day_size;
+
+        ($tmp1, $tmp2);
+    },
+    years =>     sub {
+        my ($self, $index, $index2) = @_;
+        return ($self, $self) if $self == $inf;
+        # my $class = ref($self);
+        # print " [ofs:year:$self -- $index]\n";
+        my @date = gmtime( $self ); 
+        $date[5] +=    1900 + $index;
+        my $tmp = timegm(@date);
+
+        $date[5] +=    $index2 - $index;
+        my $tmp2 = timegm(@date);
+
+        ($tmp, $tmp2);
+    },
+    months =>     sub {
+        my ($self, $index, $index2) = @_;
+        # carp " [ofs:month:$self -- $index -- $inf]";
+        return ($self, $self) if $self == $inf;
+        # my $class = ref($self);
+        my @date = gmtime( $self );
+
+        my $mon =     $date[4] + $index; 
+        my $year =    $date[5] + 1900;
+        # print " [OFS: month: from $year$mon ]\n";
+        if (($mon > 11) or ($mon < 0)) {
+            my $addyear = floor($mon / 12);
+            $mon = $mon - 12 * $addyear;
+            $year += $addyear;
+        }
+
+        my $mon2 =     $date[4] + $index2; 
+        my $year2 =    $date[5] + 1900;
+        if (($mon2 > 11) or ($mon2 < 0)) {
+            my $addyear2 = floor($mon2 / 12);
+            $mon2 = $mon2 - 12 * $addyear2;
+            $year2 += $addyear2;
+        }
+
+        # print " [OFS: month: to $year $mon ]\n";
+
+        $date[4] = $mon;
+        $date[5] = $year;
+        my $tmp = timegm(@date);
+
+        $date[4] = $mon2;
+        $date[5] = $year2;
+        my $tmp2 = timegm(@date);
+
+        ($tmp, $tmp2);
+    },
+    days =>     sub { 
+        ( $_[0] + $_[1] * $day_size,
+          $_[0] + $_[2] * $day_size,
+        )
+    },
+    weeks =>    sub { 
+        ( $_[0] + $_[1] * (7 * $day_size),
+          $_[0] + $_[2] * (7 * $day_size),
+        )
+    },
+    hours =>    sub { 
+        # carp " [ $_[0]+$_[1] hour = ".( $_[0] + $_[1] * $hour_size )." mode=".($_[0]->{mode})." ]";
+        ( $_[0] + $_[1] * $hour_size,
+          $_[0] + $_[2] * $hour_size,
+        )
+    },
+    minutes =>    sub { 
+        ( $_[0] + $_[1] * $minute_size,
+          $_[0] + $_[2] * $minute_size,
+        )
+    },
+    seconds =>    sub { 
+        ( $_[0] + $_[1] * $second_size, 
+          $_[0] + $_[2] * $second_size, 
+        )
+    },
+    one =>      sub { 
+        ( $_[0] + $_[1], 
+          $_[0] + $_[2], 
+        )
+    },
+);
+
+
+@week_start = ( 0, -1, -2, -3, 3, 2, 1, 0, -1, -2, -3, 3, 2, 1, 0 );
+
+=head2 %Offset_to_value($object, $offset)
+
+=head2 %Init_quantizer($object)
+
+    $Offset_to_value{$unit} ($object, $offset);
+
+    $Init_quantizer{$unit} ($object);
+
+Maps an 'offset value' to a 'value'
+
+A hash of functions that return ( int($object) + $offset ) in $unit context.
+
+Init_quantizer subroutines must be called before using subs_offset1 functions.
+
+int(object)+offset is a scalar.
+
+Offset_to_value is optimized for calling it multiple times on the same object,
+with different offsets. That's why there is a separate initialization
+subroutine.
+
+$self->{offset} is created on initialization. It is an index used 
+by the memoization cache.
+
+=cut
+
+%Offset_to_value = (
+    weekyears =>    sub {
+        my ($self, $index) = @_;
+        my $epoch = timegm( 0,0,0, 
+            1,0,$self->{offset} + $self->{quant} * $index);
+        my @time = gmtime($epoch);
+        # print " [QT_D:weekyears:$self->{offset} + $self->{quant} * $index]\n";
+        # year modulo week
+        # print " [QT:weekyears: time = ",join(";", @time )," ]\n";
+        $epoch += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size;
+        # print " [QT:weekyears: week=",join(";", gmtime($epoch) )," wkst=$self->{wkst} tbl[",$time[6] + 7 - $self->{wkst},"]=",$week_start[$time[6] + 7 - $self->{wkst}]," ]\n\n";
+
+        my $epoch2 = timegm( 0,0,0,
+            1,0,$self->{offset} + $self->{quant} * (1 + $index) );
+        @time = gmtime($epoch2);
+        $epoch2 += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size;
+        ( $epoch, $epoch2 );
+    },
+    years =>     sub {
+        my $index = $_[0]->{offset} + $_[0]->{quant} * $_[1];
+        ( timegm( 0,0,0, 1, 0, $index),
+          timegm( 0,0,0, 1, 0, $index + $_[0]->{quant}) )
+      },
+    months =>     sub {
+        my $mon = $_[0]->{offset} + $_[0]->{quant} * $_[1]; 
+        my $year = int($mon / 12);
+        $mon -= $year * 12;
+        my $tmp = timegm( 0,0,0, 1, $mon, $year);
+
+        $mon += $year * 12 + $_[0]->{quant};
+        $year = int($mon / 12);
+        $mon -= $year * 12;
+        ( $tmp, timegm( 0,0,0, 1, $mon, $year) );
+      },
+    weeks =>    sub {
+        my $tmp = 3 * $day_size + $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
+        ($tmp, $tmp + $_[0]->{quant})
+      },
+    days =>     sub {
+        my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
+        ($tmp, $tmp + $_[0]->{quant})
+      },
+    hours =>    sub {
+        my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
+        ($tmp, $tmp + $_[0]->{quant})
+      },
+    minutes =>    sub {
+        my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
+        ($tmp, $tmp + $_[0]->{quant})
+      },
+    seconds =>    sub {
+        my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
+        ($tmp, $tmp + $_[0]->{quant})
+      },
+    one =>       sub { 
+        my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
+        ($tmp, $tmp + $_[0]->{quant})
+      },
+);
+
+
+# Maps an 'offset value' to a 'value'
+
+%Value_to_offset = (
+    one =>      sub { floor( $_[1] / $_[0]{quant} ) },
+    seconds =>  sub { floor( $_[1] / $_[0]{quant} ) },
+    minutes =>  sub { floor( $_[1] / $_[0]{quant} ) },
+    hours =>    sub { floor( $_[1] / $_[0]{quant} ) },
+    days =>     sub { floor( $_[1] / $_[0]{quant} ) },
+    weeks =>    sub { floor( ($_[1] - 3 * $day_size) / $_[0]{quant} ) },
+    months =>   sub {
+        my @date = gmtime( 0 + $_[1] );
+        my $tmp = $date[4] + 12 * (1900 + $date[5]);
+        floor( $tmp / $_[0]{quant} );
+      },
+    years =>    sub {
+        my @date = gmtime( 0 + $_[1] );
+        my $tmp = $date[5] + 1900;
+        floor( $tmp / $_[0]{quant} );
+      },
+    weekyears =>    sub {
+
+        my ($self, $value) = @_;
+        my @date;
+
+        # find out YEAR number
+        @date = gmtime( 0 + $value );
+        my $year = floor( $date[5] + 1900 / $self->{quant} );
+
+        # what is the EPOCH for this week-year's begin ?
+        my $begin_epoch = timegm( 0,0,0,  1,0,$year);
+        @date = gmtime($begin_epoch);
+        $begin_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size;
+
+        # what is the EPOCH for this week-year's end ?
+        my $end_epoch = timegm( 0,0,0,  1,0,$year+1);
+        @date = gmtime($end_epoch);
+        $end_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size;
+
+        $year-- if $value <  $begin_epoch;
+        $year++ if $value >= $end_epoch;
+
+        # carp " value=$value offset=$year this_epoch=".$begin_epoch;
+        # carp " next_epoch=".$end_epoch;
+
+        $year;
+      },
+);
+
+# Initialize quantizer
+
+%Init_quantizer = (
+    one =>       sub {},
+    seconds =>   sub { $_[0]->{quant} *= $second_size },
+    minutes =>   sub { $_[0]->{quant} *= $minute_size },
+    hours =>     sub { $_[0]->{quant} *= $hour_size },
+    days =>      sub { $_[0]->{quant} *= $day_size },
+    weeks =>     sub { $_[0]->{quant} *= 7 * $day_size },
+    months =>    sub {},
+    years =>     sub {},
+    weekyears => sub { 
+        $_[0]->{wkst} = 1 unless defined $_[0]->{wkst};
+        # select which 'cache' to use
+        # $_[0]->{memo} .= $_[0]->{wkst};
+    },
+);
+
+
+1;
+
diff --git a/modules/fallback/Set/Infinite/Basic.pm b/modules/fallback/Set/Infinite/Basic.pm
new file mode 100644
index 000000000..b917bfbe8
--- /dev/null
+++ b/modules/fallback/Set/Infinite/Basic.pm
@@ -0,0 +1,1157 @@
+package Set::Infinite::Basic;
+
+# Copyright (c) 2001, 2002, 2003 Flavio Soibelmann Glock. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+require 5.005_03;
+use strict;
+
+require Exporter;
+use Carp;
+use Data::Dumper; 
+use vars qw( @ISA @EXPORT_OK @EXPORT );
+use vars qw( $Type $tolerance $fixtype $inf $minus_inf @Separators $neg_inf );
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw( INFINITY NEG_INFINITY );
+@EXPORT = qw();
+
+use constant INFINITY => 100**100**100;
+use constant NEG_INFINITY => - INFINITY;
+
+$inf       = INFINITY;
+$minus_inf = $neg_inf = NEG_INFINITY;
+
+use overload
+    '<=>' => \&spaceship,
+    qw("" as_string),
+;
+
+
+# TODO: make this an object _and_ class method
+# TODO: POD
+sub separators {
+    shift;
+    return $Separators[ $_[0] ] if $#_ == 0;
+    @Separators = @_ if @_;
+    return @Separators;
+}
+
+BEGIN {
+    __PACKAGE__->separators (
+        '[', ']',    # a closed interval
+        '(', ')',    # an open interval
+        '..',        # number separator
+        ',',         # list separator
+        '', '',      # set delimiter  '{' '}'
+    );
+    # global defaults for object private vars
+    $Type = undef;
+    $tolerance = 0;
+    $fixtype = 1;
+}
+
+# _simple_* set of internal methods: basic processing of "spans"
+
+sub _simple_intersects {
+    my $tmp1 = $_[0];
+    my $tmp2 = $_[1];
+    my ($i_beg, $i_end, $open_beg, $open_end);
+    my $cmp = $tmp1->{a} <=> $tmp2->{a};
+    if ($cmp < 0) {
+        $i_beg       = $tmp2->{a};
+        $open_beg    = $tmp2->{open_begin};
+    }
+    elsif ($cmp > 0) {
+        $i_beg       = $tmp1->{a};
+        $open_beg    = $tmp1->{open_begin};
+    }
+    else {
+        $i_beg       = $tmp1->{a};
+        $open_beg    = $tmp1->{open_begin} || $tmp2->{open_begin};
+    }
+    $cmp = $tmp1->{b} <=> $tmp2->{b};
+    if ($cmp > 0) {
+        $i_end       = $tmp2->{b};
+        $open_end    = $tmp2->{open_end};
+    }
+    elsif ($cmp < 0) {
+        $i_end       = $tmp1->{b};
+        $open_end    = $tmp1->{open_end};
+    }
+    else { 
+        $i_end       = $tmp1->{b};
+        $open_end    = ($tmp1->{open_end} || $tmp2->{open_end});
+    }
+    $cmp = $i_beg <=> $i_end;
+    return 0 if 
+        ( $cmp > 0 ) || 
+        ( ($cmp == 0) && ($open_beg || $open_end) ) ;
+    return 1;
+}
+
+
+sub _simple_complement {
+    my $self = $_[0];
+    if ($self->{b} == $inf) {
+        return if $self->{a} == $neg_inf;
+        return { a => $neg_inf, 
+                 b => $self->{a}, 
+                 open_begin => 1, 
+                 open_end => ! $self->{open_begin} };
+    }
+    if ($self->{a} == $neg_inf) {
+        return { a => $self->{b}, 
+                 b => $inf,  
+                 open_begin => ! $self->{open_end}, 
+                 open_end => 1 };
+    }
+    ( { a => $neg_inf, 
+        b => $self->{a}, 
+        open_begin => 1, 
+        open_end => ! $self->{open_begin} 
+      },
+      { a => $self->{b}, 
+        b => $inf,  
+        open_begin => ! $self->{open_end}, 
+        open_end => 1 
+      }
+    );
+}
+
+sub _simple_union {
+    my ($tmp2, $tmp1, $tolerance) = @_; 
+    my $cmp; 
+    if ($tolerance) {
+        # "integer"
+        my $a1_open =  $tmp1->{open_begin} ? -$tolerance : $tolerance ;
+        my $b1_open =  $tmp1->{open_end}   ? -$tolerance : $tolerance ;
+        my $a2_open =  $tmp2->{open_begin} ? -$tolerance : $tolerance ;
+        my $b2_open =  $tmp2->{open_end}   ? -$tolerance : $tolerance ;
+        # open_end touching?
+        if ((($tmp1->{b}+$tmp1->{b}) + $b1_open ) < 
+            (($tmp2->{a}+$tmp2->{a}) - $a2_open)) {
+            # self disjuncts b
+            return ( $tmp1, $tmp2 );
+        }
+        if ((($tmp1->{a}+$tmp1->{a}) - $a1_open ) > 
+            (($tmp2->{b}+$tmp2->{b}) + $b2_open)) {
+            # self disjuncts b
+            return ( $tmp2, $tmp1 );
+        }
+    }
+    else {
+        # "real"
+        $cmp = $tmp1->{b} <=> $tmp2->{a};
+        if ( $cmp < 0 ||
+             ( $cmp == 0 && $tmp1->{open_end} && $tmp2->{open_begin} ) ) {
+            return ( $tmp1, $tmp2 );
+        }
+        $cmp = $tmp1->{a} <=> $tmp2->{b};
+        if ( $cmp > 0 || 
+             ( $cmp == 0 && $tmp2->{open_end} && $tmp1->{open_begin} ) ) {
+            return ( $tmp2, $tmp1 );
+        }
+    }
+
+    my $tmp;
+    $cmp = $tmp1->{a} <=> $tmp2->{a};
+    if ($cmp > 0) {
+        $tmp->{a} = $tmp2->{a};
+        $tmp->{open_begin} = $tmp2->{open_begin};
+    }
+    elsif ($cmp == 0) {
+        $tmp->{a} = $tmp1->{a};
+        $tmp->{open_begin} = $tmp1->{open_begin} ? $tmp2->{open_begin} : 0;
+    }
+    else {
+        $tmp->{a} = $tmp1->{a};
+        $tmp->{open_begin} = $tmp1->{open_begin};
+    }
+
+    $cmp = $tmp1->{b} <=> $tmp2->{b};
+    if ($cmp < 0) {
+        $tmp->{b} = $tmp2->{b};
+        $tmp->{open_end} = $tmp2->{open_end};
+    }
+    elsif ($cmp == 0) {
+        $tmp->{b} = $tmp1->{b};
+        $tmp->{open_end} = $tmp1->{open_end} ? $tmp2->{open_end} : 0;
+    }
+    else {
+        $tmp->{b} = $tmp1->{b};
+        $tmp->{open_end} = $tmp1->{open_end};
+    }
+    return $tmp;
+}
+
+
+sub _simple_spaceship {
+    my ($tmp1, $tmp2, $inverted) = @_;
+    my $cmp;
+    if ($inverted) {
+        $cmp = $tmp2->{a} <=> $tmp1->{a};
+        return $cmp if $cmp;
+        $cmp = $tmp1->{open_begin} <=> $tmp2->{open_begin};
+        return $cmp if $cmp;
+        $cmp = $tmp2->{b} <=> $tmp1->{b};
+        return $cmp if $cmp;
+        return $tmp1->{open_end} <=> $tmp2->{open_end};
+    }
+    $cmp = $tmp1->{a} <=> $tmp2->{a};
+    return $cmp if $cmp;
+    $cmp = $tmp2->{open_begin} <=> $tmp1->{open_begin};
+    return $cmp if $cmp;
+    $cmp = $tmp1->{b} <=> $tmp2->{b};
+    return $cmp if $cmp;
+    return $tmp2->{open_end} <=> $tmp1->{open_end};
+}
+
+
+sub _simple_new {
+    my ($tmp, $tmp2, $type) = @_;
+    if ($type) {
+        if ( ref($tmp) ne $type ) { 
+            $tmp = new $type $tmp;
+        }
+        if ( ref($tmp2) ne $type ) {
+            $tmp2 = new $type $tmp2;
+        }
+    }
+    if ($tmp > $tmp2) {
+        carp "Invalid interval specification: start value is after end";
+        # ($tmp, $tmp2) = ($tmp2, $tmp);
+    }
+    return { a => $tmp , b => $tmp2 , open_begin => 0 , open_end => 0 };
+}
+
+
+sub _simple_as_string {
+    my $set = shift;
+    my $self = $_[0];
+    my $s;
+    return "" unless defined $self;
+    $self->{open_begin} = 1 if ($self->{a} == -$inf );
+    $self->{open_end}   = 1 if ($self->{b} == $inf );
+    my $tmp1 = $self->{a};
+    $tmp1 = $tmp1->datetime if UNIVERSAL::can( $tmp1, 'datetime' );
+    $tmp1 = "$tmp1";
+    my $tmp2 = $self->{b};
+    $tmp2 = $tmp2->datetime if UNIVERSAL::can( $tmp2, 'datetime' );
+    $tmp2 = "$tmp2";
+    return $tmp1 if $tmp1 eq $tmp2;
+    $s = $self->{open_begin} ? $set->separators(2) : $set->separators(0);
+    $s .= $tmp1 . $set->separators(4) . $tmp2;
+    $s .= $self->{open_end} ? $set->separators(3) : $set->separators(1);
+    return $s;
+}
+
+# end of "_simple_" methods
+
+
+sub type {
+    my $self = shift;
+    unless (@_) {
+        return ref($self) ? $self->{type} : $Type;
+    }
+    my $tmp_type = shift;
+    eval "use " . $tmp_type;
+    carp "Warning: can't start $tmp_type : $@" if $@;
+    if (ref($self))  {
+        $self->{type} = $tmp_type;
+        return $self;
+    }
+    else {
+        $Type = $tmp_type;
+        return $Type;
+    }
+}
+
+sub list {
+    my $self = shift;
+    my @b = ();
+    foreach (@{$self->{list}}) {
+        push @b, $self->new($_);
+    }
+    return @b;
+}
+
+sub fixtype {
+    my $self = shift;
+    $self = $self->copy;
+    $self->{fixtype} = 1;
+    my $type = $self->type;
+    return $self unless $type;
+    foreach (@{$self->{list}}) {
+        $_->{a} = $type->new($_->{a}) unless ref($_->{a}) eq $type;
+        $_->{b} = $type->new($_->{b}) unless ref($_->{b}) eq $type;
+    }
+    return $self;
+}
+
+sub numeric {
+    my $self = shift;
+    return $self unless $self->{fixtype};
+    $self = $self->copy;
+    $self->{fixtype} = 0;
+    foreach (@{$self->{list}}) {
+        $_->{a} = 0 + $_->{a};
+        $_->{b} = 0 + $_->{b};
+    }
+    return $self;
+}
+
+sub _no_cleanup { $_[0] }   # obsolete
+
+sub first {
+    my $self = $_[0];
+    if (exists $self->{first} ) {
+        return wantarray ? @{$self->{first}} : $self->{first}[0];
+    }
+    unless ( @{$self->{list}} ) {
+        return wantarray ? (undef, 0) : undef; 
+    }
+    my $first = $self->new( $self->{list}[0] );
+    return $first unless wantarray;
+    my $res = $self->new;   
+    push @{$res->{list}}, @{$self->{list}}[1 .. $#{$self->{list}}];
+    return @{$self->{first}} = ($first) if $res->is_null;
+    return @{$self->{first}} = ($first, $res);
+}
+
+sub last {
+    my $self = $_[0];
+    if (exists $self->{last} ) {
+        return wantarray ? @{$self->{last}} : $self->{last}[0];
+    }
+    unless ( @{$self->{list}} ) {
+        return wantarray ? (undef, 0) : undef;
+    }
+    my $last = $self->new( $self->{list}[-1] );
+    return $last unless wantarray;  
+    my $res = $self->new; 
+    push @{$res->{list}}, @{$self->{list}}[0 .. $#{$self->{list}}-1];
+    return @{$self->{last}} = ($last) if $res->is_null;
+    return @{$self->{last}} = ($last, $res);
+}
+
+sub is_null {
+    @{$_[0]->{list}} ? 0 : 1;
+}
+
+sub is_empty {
+    $_[0]->is_null;
+}
+
+sub is_nonempty {
+    ! $_[0]->is_null;
+}
+
+sub is_span {
+    ( $#{$_[0]->{list}} == 0 ) ? 1 : 0;
+}
+
+sub is_singleton {
+    ( $#{$_[0]->{list}} == 0 &&
+      $_[0]->{list}[0]{a} == $_[0]->{list}[0]{b} ) ? 1 : 0;
+}
+
+sub is_subset {
+    my $a1 = shift;
+    my $b1;
+    if (ref ($_[0]) eq ref($a1) ) { 
+        $b1 = shift;
+    } 
+    else {
+        $b1 = $a1->new(@_);  
+    }
+    return $b1->contains( $a1 );
+}
+
+sub is_proper_subset {
+    my $a1 = shift;
+    my $b1;
+    if (ref ($_[0]) eq ref($a1) ) { 
+        $b1 = shift;
+    } 
+    else {
+        $b1 = $a1->new(@_);  
+    }
+
+    my $contains = $b1->contains( $a1 );
+    return $contains unless $contains;
+     
+    my $equal = ( $a1 == $b1 );
+    return $equal if !defined $equal || $equal;
+
+    return 1;
+}
+
+sub is_disjoint {
+    my $intersects = shift->intersects( @_ );
+    return ! $intersects if defined $intersects;
+    return $intersects;
+}
+
+sub iterate {
+    # TODO: options 'no-sort', 'no-merge', 'keep-null' ...
+    my $a1 = shift;
+    my $iterate = $a1->empty_set();
+    my (@tmp, $ia);
+    my $subroutine = shift;
+    foreach $ia (0 .. $#{$a1->{list}}) {
+        @tmp = $subroutine->( $a1->new($a1->{list}[$ia]), @_ );
+        $iterate = $iterate->union(@tmp) if @tmp; 
+    }
+    return $iterate;    
+}
+
+
+sub intersection {
+    my $a1 = shift;
+    my $b1 = ref ($_[0]) eq ref($a1) ? $_[0] : $a1->new(@_);
+    return _intersection ( 'intersection', $a1, $b1 );
+}
+
+sub intersects {
+    my $a1 = shift;
+    my $b1 = ref ($_[0]) eq ref($a1) ? $_[0] : $a1->new(@_);
+    return _intersection ( 'intersects', $a1, $b1 );
+}
+
+sub intersected_spans {
+    my $a1 = shift;
+    my $b1 = ref ($_[0]) eq ref($a1) ? $_[0] : $a1->new(@_);
+    return _intersection ( 'intersected_spans', $a1, $b1 );
+}
+
+
+sub _intersection {
+    my ( $op, $a1, $b1 ) = @_;
+
+    my $ia;   
+    my ( $a0, $na ) = ( 0, $#{$a1->{list}} );
+    my ( $tmp1, $tmp1a, $tmp2a, $tmp1b, $tmp2b, $i_beg, $i_end, $open_beg, $open_end );
+    my ( $cmp1, $cmp2 );
+    my @a;
+
+    # for-loop optimization (makes little difference)
+    # This was kept for backward compatibility with Date::Set tests
+    my $self = $a1;
+    if ($na < $#{ $b1->{list} })
+    {
+        $na = $#{ $b1->{list} };
+        ($a1, $b1) = ($b1, $a1);
+    }
+    # ---
+
+    B: foreach my $tmp2 ( @{ $b1->{list} } ) {
+        $tmp2a = $tmp2->{a};
+        $tmp2b = $tmp2->{b};
+        A: foreach $ia ($a0 .. $na) {
+            $tmp1 = $a1->{list}[$ia];
+            $tmp1b = $tmp1->{b};
+
+            if ($tmp1b < $tmp2a) {
+                $a0++;
+                next A;
+            }
+            $tmp1a = $tmp1->{a};
+            if ($tmp1a > $tmp2b) {
+                next B;
+            }
+
+            $cmp1 = $tmp1a <=> $tmp2a;
+            if ( $cmp1 < 0 ) {
+                $tmp1a        = $tmp2a;
+                $open_beg     = $tmp2->{open_begin};
+            }
+            elsif ( $cmp1 ) {
+                $open_beg     = $tmp1->{open_begin};
+            }
+            else {
+                $open_beg     = $tmp1->{open_begin} || $tmp2->{open_begin};
+            }
+
+            $cmp2 = $tmp1b <=> $tmp2b;
+            if ( $cmp2 > 0 ) {
+                $tmp1b        = $tmp2b;
+                $open_end     = $tmp2->{open_end};
+            }
+            elsif ( $cmp2 ) {
+                $open_end     = $tmp1->{open_end};
+            }
+            else {
+                $open_end     = $tmp1->{open_end} || $tmp2->{open_end};
+            }
+
+            if ( ( $tmp1a <= $tmp1b ) &&
+                 ( ($tmp1a != $tmp1b) || 
+                   (!$open_beg and !$open_end) ||
+                   ($tmp1a == $inf)   ||               # XXX
+                   ($tmp1a == $neg_inf)
+                 )
+               ) 
+            {
+                if ( $op eq 'intersection' )
+                {
+                    push @a, {
+                        a => $tmp1a, b => $tmp1b, 
+                        open_begin => $open_beg, open_end => $open_end } ;
+                }
+                if ( $op eq 'intersects' )
+                {
+                    return 1;
+                }
+                if ( $op eq 'intersected_spans' )
+                {
+                    push @a, $tmp1;
+                    $a0++;
+                    next A;
+                }
+            }
+        }
+    }
+
+    return 0 if $op eq 'intersects';
+   
+    my $intersection = $self->new();
+    $intersection->{list} = \@a;
+    return $intersection;    
+}
+
+
+sub complement {
+    my $self = shift;
+    if (@_) {
+        my $a1;
+        if (ref ($_[0]) eq ref($self) ) {
+            $a1 = shift;
+        } 
+        else {
+            $a1 = $self->new(@_);  
+        }
+        return $self->intersection( $a1->complement );
+    }
+
+    unless ( @{$self->{list}} ) {
+        return $self->universal_set;
+    }
+    my $complement = $self->empty_set();
+    @{$complement->{list}} = _simple_complement($self->{list}[0]); 
+
+    my $tmp = $self->empty_set();    
+    foreach my $ia (1 .. $#{$self->{list}}) {
+        @{$tmp->{list}} = _simple_complement($self->{list}[$ia]);
+        $complement = $complement->intersection($tmp); 
+    }
+    return $complement;    
+}
+
+
+sub until {
+    my $a1 = shift;
+    my $b1;
+    if (ref ($_[0]) eq ref($a1) ) {
+        $b1 = shift;
+    } 
+    else {
+        $b1 = $a1->new(@_);  
+    }
+    my @b1_min = $b1->min_a;
+    my @a1_max = $a1->max_a;
+
+    unless (defined $b1_min[0]) {
+        return $a1->until($inf);
+    } 
+    unless (defined $a1_max[0]) {
+        return $a1->new(-$inf)->until($b1);
+    }
+
+    my ($ia, $ib, $begin, $end);
+    $ia = 0;
+    $ib = 0;
+
+    my $u = $a1->new;   
+    my $last = -$inf;
+    while ( ($ia <= $#{$a1->{list}}) && ($ib <= $#{$b1->{list}})) {
+        $begin = $a1->{list}[$ia]{a};
+        $end   = $b1->{list}[$ib]{b};
+        if ( $end <= $begin ) {
+            push @{$u->{list}}, {
+                a => $last ,
+                b => $end ,
+                open_begin => 0 ,
+                open_end => 1 };
+            $ib++;
+            $last = $end;
+            next;
+        }
+        push @{$u->{list}}, { 
+            a => $begin , 
+            b => $end ,
+            open_begin => 0 , 
+            open_end => 1 };
+        $ib++;
+        $ia++;
+        $last = $end;
+    }
+    if ($ia <= $#{$a1->{list}}  &&
+        $a1->{list}[$ia]{a} >= $last ) 
+    {
+        push @{$u->{list}}, {
+            a => $a1->{list}[$ia]{a} ,
+            b => $inf ,
+            open_begin => 0 ,
+            open_end => 1 };
+    }
+    return $u;    
+}
+
+sub start_set {
+    return $_[0]->iterate(
+        sub { $_[0]->min }
+    );
+}
+
+
+sub end_set {
+    return $_[0]->iterate(
+        sub { $_[0]->max }
+    );
+}
+
+sub union {
+    my $a1 = shift;
+    my $b1;
+    if (ref ($_[0]) eq ref($a1) ) {
+        $b1 = shift;
+    } 
+    else {
+        $b1 = $a1->new(@_);  
+    }
+    # test for union with empty set
+    if ( $#{ $a1->{list} } < 0 ) {
+        return $b1;
+    }
+    if ( $#{ $b1->{list} } < 0 ) {
+        return $a1;
+    }
+    my @b1_min = $b1->min_a;
+    my @a1_max = $a1->max_a;
+    unless (defined $b1_min[0]) {
+        return $a1;
+    }
+    unless (defined $a1_max[0]) {
+        return $b1;
+    }
+    my ($ia, $ib);
+    $ia = 0;
+    $ib = 0;
+
+    #  size+order matters on speed 
+    $a1 = $a1->new($a1);    # don't modify ourselves 
+    my $b_list = $b1->{list};
+    # -- frequent case - $b1 is after $a1
+    if ($b1_min[0] > $a1_max[0]) {
+        push @{$a1->{list}}, @$b_list;
+        return $a1;
+    }
+
+    my @tmp;
+    my $is_real = !$a1->tolerance && !$b1->tolerance;
+    B: foreach $ib ($ib .. $#{$b_list}) {
+        foreach $ia ($ia .. $#{$a1->{list}}) {
+            @tmp = _simple_union($a1->{list}[$ia], $b_list->[$ib], $a1->{tolerance});
+            if ($#tmp == 0) {
+                    $a1->{list}[$ia] = $tmp[0];
+
+                    while (1) {
+                        last if $ia >= $#{$a1->{list}};    
+                        last unless _simple_intersects ( $a1->{list}[$ia], $a1->{list}[$ia + 1] )
+                            ||    $is_real 
+                               && $a1->{list}[$ia]{b} == $a1->{list}[$ia + 1]{a};
+                        @tmp = _simple_union($a1->{list}[$ia], $a1->{list}[$ia + 1], $a1->{tolerance});
+                        last unless @tmp == 1;
+                        $a1->{list}[$ia] = $tmp[0];
+                        splice( @{$a1->{list}}, $ia + 1, 1 );
+                    }
+                    
+                    next B;
+            }
+            if ($a1->{list}[$ia]{a} >= $b_list->[$ib]{a}) {
+                splice (@{$a1->{list}}, $ia, 0, $b_list->[$ib]);
+                next B;
+            }
+        }
+        push @{$a1->{list}}, $b_list->[$ib];
+    }
+    return $a1;    
+}
+
+
+# there are some ways to process 'contains':
+# A CONTAINS B IF A == ( A UNION B )
+#    - faster
+# A CONTAINS B IF B == ( A INTERSECTION B )
+#    - can backtrack = works for unbounded sets
+sub contains {
+    my $a1 = shift;
+    my $b1 = $a1->union(@_);
+    return ($b1 == $a1) ? 1 : 0;
+}
+
+
+sub copy {
+    my $self = shift;
+    my $copy = $self->empty_set();
+    ## return $copy unless ref($self);   # constructor!
+    foreach my $key (keys %{$self}) {
+        if ( ref( $self->{$key} ) eq 'ARRAY' ) {
+            @{ $copy->{$key} } = @{ $self->{$key} };
+        }
+        else {
+            $copy->{$key} = $self->{$key};
+        }
+    }
+    return $copy;
+}
+
+*clone = \&copy;
+
+
+sub new {
+    my $class = shift;
+    my $self;
+    if ( ref $class ) {
+        $self = bless {
+                    list      => [],
+                    tolerance => $class->{tolerance},
+                    type      => $class->{type},
+                    fixtype   => $class->{fixtype},
+                }, ref($class);
+    }
+    else {
+        $self = bless { 
+                    list      => [],
+                    tolerance => $tolerance ? $tolerance : 0,
+                    type      => $class->type,
+                    fixtype   => $fixtype   ? $fixtype : 0,
+                }, $class;
+    }
+    my ($tmp, $tmp2, $ref);
+    while (@_) {
+        $tmp = shift;
+        $ref = ref($tmp);
+        if ($ref) {
+            if ($ref eq 'ARRAY') {
+                # allows arrays of arrays
+                $tmp = $class->new(@$tmp);  # call new() recursively
+                push @{ $self->{list} }, @{$tmp->{list}};
+                next;
+            }
+            if ($ref eq 'HASH') {
+                push @{ $self->{list} }, $tmp; 
+                next;
+            }
+            if ($tmp->isa(__PACKAGE__)) {
+                push @{ $self->{list} }, @{$tmp->{list}};
+                next;
+            }
+        }
+        if ( @_ ) { 
+            $tmp2 = shift
+        }
+        else {
+            $tmp2 = $tmp
+        }
+        push @{ $self->{list} }, _simple_new($tmp,$tmp2, $self->{type} )
+    }
+    $self;
+}
+
+sub empty_set {
+    $_[0]->new;
+}
+
+sub universal_set {
+    $_[0]->new( NEG_INFINITY, INFINITY );
+}
+
+*minus = \&complement;
+
+*difference = \&complement;
+
+sub symmetric_difference {
+    my $a1 = shift;
+    my $b1;
+    if (ref ($_[0]) eq ref($a1) ) {
+        $b1 = shift;
+    }
+    else {
+        $b1 = $a1->new(@_);
+    }
+
+    return $a1->complement( $b1 )->union(
+           $b1->complement( $a1 ) );
+}
+
+*simmetric_difference = \&symmetric_difference; # bugfix
+
+sub min { 
+    ($_[0]->min_a)[0];
+}
+
+sub min_a { 
+    my $self = $_[0];
+    return @{$self->{min}} if exists $self->{min};
+    return @{$self->{min}} = (undef, 0) unless @{$self->{list}};
+    my $tmp = $self->{list}[0]{a};
+    my $tmp2 = $self->{list}[0]{open_begin} || 0;
+    if ($tmp2 && $self->{tolerance}) {
+        $tmp2 = 0;
+        $tmp += $self->{tolerance};
+    }
+    return @{$self->{min}} = ($tmp, $tmp2);  
+};
+
+sub max { 
+    ($_[0]->max_a)[0];
+}
+
+sub max_a { 
+    my $self = $_[0];
+    return @{$self->{max}} if exists $self->{max};
+    return @{$self->{max}} = (undef, 0) unless @{$self->{list}};
+    my $tmp = $self->{list}[-1]{b};
+    my $tmp2 = $self->{list}[-1]{open_end} || 0;
+    if ($tmp2 && $self->{tolerance}) {
+        $tmp2 = 0;
+        $tmp -= $self->{tolerance};
+    }
+    return @{$self->{max}} = ($tmp, $tmp2);  
+};
+
+sub count {
+    1 + $#{$_[0]->{list}};
+}
+
+sub size { 
+    my $self = $_[0];
+    my $size;  
+    foreach( @{$self->{list}} ) {
+        if ( $size ) {
+            $size += $_->{b} - $_->{a};
+        }
+        else {
+            $size = $_->{b} - $_->{a};
+        }
+        if ( $self->{tolerance} ) {
+            $size += $self->{tolerance} unless $_->{open_end};
+            $size -= $self->{tolerance} if $_->{open_begin};
+            $size -= $self->{tolerance} if $_->{open_end};
+        }
+    }
+    return $size; 
+};
+
+sub span { 
+    my $self = $_[0];
+    my @max = $self->max_a;
+    my @min = $self->min_a;
+    return undef unless defined $min[0] && defined $max[0];
+    my $a1 = $self->new($min[0], $max[0]);
+    $a1->{list}[0]{open_end} = $max[1];
+    $a1->{list}[0]{open_begin} = $min[1];
+    return $a1;
+};
+
+sub spaceship {
+    my ($tmp1, $tmp2, $inverted) = @_;
+    if ($inverted) {
+        ($tmp2, $tmp1) = ($tmp1, $tmp2);
+    }
+    foreach(0 .. $#{$tmp1->{list}}) {
+        my $this  = $tmp1->{list}[$_];
+        if ($_ > $#{ $tmp2->{list} } ) { 
+            return 1; 
+        }
+        my $other = $tmp2->{list}[$_];
+        my $cmp = _simple_spaceship($this, $other);
+        return $cmp if $cmp;   # this != $other;
+    }
+    return $#{ $tmp1->{list} } == $#{ $tmp2->{list} } ? 0 : -1;
+}
+
+sub tolerance {
+    my $self = shift;
+    my $tmp = pop;
+    if (ref($self)) {  
+        # local
+        return $self->{tolerance} unless defined $tmp;
+        $self = $self->copy;
+        $self->{tolerance} = $tmp;
+        delete $self->{max};  # tolerance may change "max"
+
+        $_ = 1;
+        my @tmp;
+        while ( $_ <= $#{$self->{list}} ) {
+            @tmp = Set::Infinite::Basic::_simple_union($self->{list}->[$_],
+                $self->{list}->[$_ - 1],
+                $self->{tolerance});
+            if ($#tmp == 0) {
+                $self->{list}->[$_ - 1] = $tmp[0];
+                splice (@{$self->{list}}, $_, 1);
+            }
+            else {
+                $_ ++;
+            }
+        }
+
+        return $self;
+    }
+    # global
+    $tolerance = $tmp if defined($tmp);
+    return $tolerance;
+}
+
+sub integer { 
+    $_[0]->tolerance (1);
+}
+
+sub real {
+    $_[0]->tolerance (0);
+}
+
+sub as_string {
+    my $self = shift;
+    return $self->separators(6) . 
+           join( $self->separators(5), 
+                 map { $self->_simple_as_string($_) } @{$self->{list}} ) .
+           $self->separators(7),;
+}
+
+
+sub DESTROY {}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Set::Infinite::Basic - Sets of intervals
+6
+=head1 SYNOPSIS
+
+  use Set::Infinite::Basic;
+
+  $set = Set::Infinite::Basic->new(1,2);    # [1..2]
+  print $set->union(5,6);            # [1..2],[5..6]
+
+=head1 DESCRIPTION
+
+Set::Infinite::Basic is a Set Theory module for infinite sets.
+
+It works on reals, integers, and objects.
+
+This module does not support recurrences. Recurrences are implemented in Set::Infinite.
+
+=head1 METHODS
+
+=head2 empty_set
+
+Creates an empty_set.
+
+If called from an existing set, the empty set inherits
+the "type" and "density" characteristics.
+
+=head2 universal_set
+
+Creates a set containing "all" possible elements.
+
+If called from an existing set, the universal set inherits
+the "type" and "density" characteristics.
+
+=head2 until
+
+Extends a set until another:
+
+    0,5,7 -> until 2,6,10
+
+gives
+
+    [0..2), [5..6), [7..10)
+
+Note: this function is still experimental.
+
+=head2 copy
+
+=head2 clone
+
+Makes a new object from the object's data.
+
+=head2 Mode functions:    
+
+    $set = $set->real;
+
+    $set = $set->integer;
+
+=head2 Logic functions:
+
+    $logic = $set->intersects($b);
+
+    $logic = $set->contains($b);
+
+    $logic = $set->is_null;  # also called "is_empty"
+
+=head2 Set functions:
+
+    $set = $set->union($b);    
+
+    $set = $set->intersection($b);
+
+    $set = $set->complement;
+    $set = $set->complement($b);   # can also be called "minus" or "difference"
+
+    $set = $set->symmetric_difference( $b );
+
+    $set = $set->span;   
+
+        result is (min .. max)
+
+=head2 Scalar functions:
+
+    $i = $set->min;
+
+    $i = $set->max;
+
+    $i = $set->size;  
+
+    $i = $set->count;  # number of spans
+
+=head2 Overloaded Perl functions:
+
+    print    
+
+    sort, <=> 
+
+=head2 Global functions:
+
+    separators(@i)
+
+        chooses the interval separators. 
+
+        default are [ ] ( ) '..' ','.
+
+    INFINITY
+
+        returns an 'Infinity' number.
+
+    NEG_INFINITY
+
+        returns a '-Infinity' number.
+
+    iterate ( sub { } )
+
+        Iterates over a subroutine. 
+        Returns the union of partial results.
+
+    first
+
+        In scalar context returns the first interval of a set.
+
+        In list context returns the first interval of a set, and the
+        'tail'.
+
+        Works in unbounded sets
+
+    type($i)
+
+        chooses an object data type. 
+
+        default is none (a normal perl SCALAR).
+
+        examples: 
+
+        type('Math::BigFloat');
+        type('Math::BigInt');
+        type('Set::Infinite::Date');
+            See notes on Set::Infinite::Date below.
+
+    tolerance(0)    defaults to real sets (default)
+    tolerance(1)    defaults to integer sets
+
+    real            defaults to real sets (default)
+
+    integer         defaults to integer sets
+
+=head2 Internal functions:
+
+    $set->fixtype; 
+
+    $set->numeric;
+
+=head1 CAVEATS
+
+    $set = Set::Infinite->new(10,1);
+        Will be interpreted as [1..10]
+
+    $set = Set::Infinite->new(1,2,3,4);
+        Will be interpreted as [1..2],[3..4] instead of [1,2,3,4].
+        You probably want ->new([1],[2],[3],[4]) instead,
+        or maybe ->new(1,4) 
+
+    $set = Set::Infinite->new(1..3);
+        Will be interpreted as [1..2],3 instead of [1,2,3].
+        You probably want ->new(1,3) instead.
+
+=head1 INTERNALS
+
+The internal representation of a I<span> is a hash:
+
+    { a =>   start of span,
+      b =>   end of span,
+      open_begin =>   '0' the span starts in 'a'
+                      '1' the span starts after 'a'
+      open_end =>     '0' the span ends in 'b'
+                      '1' the span ends before 'b'
+    }
+
+For example, this set:
+
+    [100..200),300,(400..infinity)
+
+is represented by the array of hashes:
+
+    list => [
+        { a => 100, b => 200, open_begin => 0, open_end => 1 },
+        { a => 300, b => 300, open_begin => 0, open_end => 0 },
+        { a => 400, b => infinity, open_begin => 0, open_end => 1 },
+    ]
+
+The I<density> of a set is stored in the C<tolerance> variable:
+
+    tolerance => 0;  # the set is made of real numbers.
+
+    tolerance => 1;  # the set is made of integers.
+
+The C<type> variable stores the I<class> of objects that will be stored in the set.
+
+    type => 'DateTime';   # this is a set of DateTime objects
+
+The I<infinity> value is generated by Perl, when it finds a numerical overflow:
+
+    $inf = 100**100**100;
+
+=head1 SEE ALSO
+
+    Set::Infinite
+
+=head1 AUTHOR
+
+    Flavio S. Glock <fglock@gmail.com>
+
+=cut
+
diff --git a/modules/fallback/Set/Infinite/_recurrence.pm b/modules/fallback/Set/Infinite/_recurrence.pm
new file mode 100644
index 000000000..376e168be
--- /dev/null
+++ b/modules/fallback/Set/Infinite/_recurrence.pm
@@ -0,0 +1,404 @@
+# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Set::Infinite::_recurrence;
+
+use strict;
+
+use constant INFINITY     =>       100 ** 100 ** 100 ;
+use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
+
+use vars qw( @ISA $PRETTY_PRINT $max_iterate );
+
+@ISA = qw( Set::Infinite );
+use Set::Infinite 0.5502;
+
+BEGIN {
+    $PRETTY_PRINT = 1;   # enable Set::Infinite debug
+    $max_iterate = 20;
+
+    # TODO: inherit %Set::Infinite::_first / _last 
+    #       in a more "object oriented" way
+
+    $Set::Infinite::_first{_recurrence} = 
+        sub {
+            my $self = $_[0];
+            my ($callback_next, $callback_previous) = @{ $self->{param} };
+            my ($min, $min_open) = $self->{parent}->min_a;
+
+            my ( $min1, $min2 );
+            $min1 = $callback_next->( $min );
+            if ( ! $min_open )
+            {
+                $min2 = $callback_previous->( $min1 );
+                $min1 = $min2 if defined $min2 && $min == $min2;
+            }
+
+            my $start = $callback_next->( $min1 );
+            my $end   = $self->{parent}->max;
+            
+            #print STDERR "set ";
+            #print STDERR $start->datetime
+            #   unless $start == INFINITY;
+            #print STDERR " - " ;
+            #print STDERR $end->datetime 
+            #    unless $end == INFINITY;
+            #print STDERR "\n";
+            
+            return ( $self->new( $min1 ), undef )
+                if $start > $end;
+
+            return ( $self->new( $min1 ),
+                     $self->new( $start, $end )->
+                          _function( '_recurrence', @{ $self->{param} } ) );
+        };
+    $Set::Infinite::_last{_recurrence} =
+        sub {
+            my $self = $_[0];
+            my ($callback_next, $callback_previous) = @{ $self->{param} };
+            my ($max, $max_open) = $self->{parent}->max_a;
+
+            my ( $max1, $max2 );
+            $max1 = $callback_previous->( $max );
+            if ( ! $max_open )
+            {
+                $max2 = $callback_next->( $max1 );
+                $max1 = $max2 if $max == $max2;
+            }
+
+            return ( $self->new( $max1 ),
+                     $self->new( $self->{parent}->min, 
+                                 $callback_previous->( $max1 ) )->
+                          _function( '_recurrence', @{ $self->{param} } ) );
+        };
+}
+
+# $si->_recurrence(
+#     \&callback_next, \&callback_previous )
+#
+# Generates "recurrences" from a callback.
+# These recurrences are simple lists of dates.
+#
+# The recurrence generation is based on an idea from Dave Rolsky.
+#
+
+# use Data::Dumper;
+# use Carp qw(cluck);
+
+sub _recurrence { 
+    my $set = shift;
+    my ( $callback_next, $callback_previous, $delta ) = @_;
+
+    $delta->{count} = 0 unless defined $delta->{delta};
+
+    # warn "reusing delta: ". $delta->{count} if defined $delta->{delta};
+    # warn Dumper( $delta );
+
+    if ( $#{ $set->{list} } != 0 || $set->is_too_complex )
+    {
+        return $set->iterate( 
+            sub { 
+                $_[0]->_recurrence( 
+                    $callback_next, $callback_previous, $delta ) 
+            } );
+    }
+    # $set is a span
+    my $result;
+    if ($set->min != NEG_INFINITY && $set->max != INFINITY)
+    {
+        # print STDERR " finite set\n";
+        my ($min, $min_open) = $set->min_a;
+        my ($max, $max_open) = $set->max_a;
+
+        my ( $min1, $min2 );
+        $min1 = $callback_next->( $min );
+        if ( ! $min_open )
+        {
+                $min2 = $callback_previous->( $min1 );
+                $min1 = $min2 if defined $min2 && $min == $min2;
+        }
+        
+        $result = $set->new();
+
+        # get "delta" - abort if this will take too much time.
+
+        unless ( defined $delta->{max_delta} )
+        {
+          for ( $delta->{count} .. 10 ) 
+          {
+            if ( $max_open )
+            {
+                return $result if $min1 >= $max;
+            }
+            else
+            {
+                return $result if $min1 > $max;
+            }
+            push @{ $result->{list} }, 
+                 { a => $min1, b => $min1, open_begin => 0, open_end => 0 };
+            $min2 = $callback_next->( $min1 );
+            
+            if ( $delta->{delta} ) 
+            {
+                $delta->{delta} += $min2 - $min1;
+            }
+            else
+            {
+                $delta->{delta} = $min2 - $min1;
+            }
+            $delta->{count}++;
+            $min1 = $min2;
+          }
+
+          $delta->{max_delta} = $delta->{delta} * 40;
+        }
+
+        if ( $max < $min + $delta->{max_delta} ) 
+        {
+          for ( 1 .. 200 ) 
+          {
+            if ( $max_open )
+            {
+                return $result if $min1 >= $max;
+            }
+            else
+            {
+                return $result if $min1 > $max;
+            }
+            push @{ $result->{list} }, 
+                 { a => $min1, b => $min1, open_begin => 0, open_end => 0 };
+            $min1 = $callback_next->( $min1 );
+          } 
+        }
+
+        # cluck "give up";
+    }
+
+    # return a "_function", such that we can backtrack later.
+    my $func = $set->_function( '_recurrence', $callback_next, $callback_previous, $delta );
+    
+    # removed - returning $result doesn't help on speed
+    ## return $func->_function2( 'union', $result ) if $result;
+
+    return $func;
+}
+
+sub is_forever
+{
+    $#{ $_[0]->{list} } == 0 &&
+    $_[0]->max == INFINITY &&
+    $_[0]->min == NEG_INFINITY
+}
+
+sub _is_recurrence 
+{
+    exists $_[0]->{method}           && 
+    $_[0]->{method} eq '_recurrence' &&
+    $_[0]->{parent}->is_forever
+}
+
+sub intersection
+{
+    my ($s1, $s2) = (shift,shift);
+
+    if ( exists $s1->{method} && $s1->{method} eq '_recurrence' )
+    {
+        # optimize: recurrence && span
+        return $s1->{parent}->
+            intersection( $s2, @_ )->
+            _recurrence( @{ $s1->{param} } )
+                unless ref($s2) && exists $s2->{method};
+
+        # optimize: recurrence && recurrence
+        if ( $s1->{parent}->is_forever && 
+            ref($s2) && _is_recurrence( $s2 ) )
+        {
+            my ( $next1, $previous1 ) = @{ $s1->{param} };
+            my ( $next2, $previous2 ) = @{ $s2->{param} };
+            return $s1->{parent}->_function( '_recurrence', 
+                  sub {
+                               # intersection of parent 'next' callbacks
+                               my ($n1, $n2);
+                               my $iterate = 0;
+                               $n2 = $next2->( $_[0] );
+                               while(1) { 
+                                   $n1 = $next1->( $previous1->( $n2 ) );
+                                   return $n1 if $n1 == $n2;
+                                   $n2 = $next2->( $previous2->( $n1 ) );
+                                   return if $iterate++ == $max_iterate;
+                               }
+                  },
+                  sub {
+                               # intersection of parent 'previous' callbacks
+                               my ($p1, $p2);
+                               my $iterate = 0;
+                               $p2 = $previous2->( $_[0] );
+                               while(1) { 
+                                   $p1 = $previous1->( $next1->( $p2 ) );
+                                   return $p1 if $p1 == $p2;
+                                   $p2 = $previous2->( $next2->( $p1 ) ); 
+                                   return if $iterate++ == $max_iterate;
+                               }
+                  },
+               );
+        }
+    }
+    return $s1->SUPER::intersection( $s2, @_ );
+}
+
+sub union
+{
+    my ($s1, $s2) = (shift,shift);
+    if ( $s1->_is_recurrence &&
+         ref($s2) && _is_recurrence( $s2 ) )
+    {
+        # optimize: recurrence || recurrence
+        my ( $next1, $previous1 ) = @{ $s1->{param} };
+        my ( $next2, $previous2 ) = @{ $s2->{param} };
+        return $s1->{parent}->_function( '_recurrence',
+                  sub {  # next
+                               my $n1 = $next1->( $_[0] );
+                               my $n2 = $next2->( $_[0] );
+                               return $n1 < $n2 ? $n1 : $n2;
+                  },
+                  sub {  # previous
+                               my $p1 = $previous1->( $_[0] );
+                               my $p2 = $previous2->( $_[0] );
+                               return $p1 > $p2 ? $p1 : $p2;
+                  },
+               );
+    }
+    return $s1->SUPER::union( $s2, @_ );
+}
+
+=head1 NAME
+
+Set::Infinite::_recurrence - Extends Set::Infinite with recurrence functions
+
+=head1 SYNOPSIS
+
+    $recurrence = $base_set->_recurrence ( \&next, \&previous );
+
+=head1 DESCRIPTION
+
+This is an internal class used by the DateTime::Set module.
+The API is subject to change.
+
+It provides all functionality provided by Set::Infinite, plus the ability
+to define recurrences with arbitrary objects, such as dates.
+
+=head1 METHODS
+
+=over 4
+
+=item * _recurrence ( \&next, \&previous )
+
+Creates a recurrence set. The set is defined inside a 'base set'.
+
+   $recurrence = $base_set->_recurrence ( \&next, \&previous );
+
+The recurrence functions take one argument, and return the 'next' or 
+the 'previous' occurence. 
+
+Example: defines the set of all 'integer numbers':
+
+    use strict;
+
+    use Set::Infinite::_recurrence;
+    use POSIX qw(floor);
+
+    # define the recurrence span
+    my $forever = Set::Infinite::_recurrence->new( 
+        Set::Infinite::_recurrence::NEG_INFINITY, 
+        Set::Infinite::_recurrence::INFINITY
+    );
+
+    my $recurrence = $forever->_recurrence(
+        sub {   # next
+                floor( $_[0] + 1 ) 
+            },   
+        sub {   # previous
+                my $tmp = floor( $_[0] ); 
+                $tmp < $_[0] ? $tmp : $_[0] - 1
+            },   
+    );
+
+    print "sample recurrence ",
+          $recurrence->intersection( -5, 5 ), "\n";
+    # sample recurrence -5,-4,-3,-2,-1,0,1,2,3,4,5
+
+    {
+        my $x = 234.567;
+        print "next occurence after $x = ", 
+              $recurrence->{param}[0]->( $x ), "\n";  # 235
+        print "previous occurence before $x = ",
+              $recurrence->{param}[2]->( $x ), "\n";  # 234
+    }
+
+    {
+        my $x = 234;
+        print "next occurence after $x = ",
+              $recurrence->{param}[0]->( $x ), "\n";  # 235
+        print "previous occurence before $x = ",
+              $recurrence->{param}[2]->( $x ), "\n";  # 233
+    }
+
+=item * is_forever
+
+Returns true if the set is a single span, 
+ranging from -Infinity to Infinity.
+
+=item * _is_recurrence
+
+Returns true if the set is an unbounded recurrence, 
+ranging from -Infinity to Infinity.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item * INFINITY
+
+The C<Infinity> value.
+
+=item * NEG_INFINITY
+
+The C<-Infinity> value.
+
+=back
+
+=head1 SUPPORT
+
+Support is offered through the C<datetime@perl.org> mailing list.
+
+Please report bugs using rt.cpan.org
+
+=head1 AUTHOR
+
+Flavio Soibelmann Glock <fglock@pucrs.br>
+
+The recurrence generation algorithm is based on an idea from Dave Rolsky.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
+This program is free software; you can distribute it and/or
+modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file
+included with this module.
+
+=head1 SEE ALSO
+
+Set::Infinite
+
+DateTime::Set
+
+For details on the Perl DateTime Suite project please see
+L<http://datetime.perl.org>.
+
+=cut
+
diff --git a/scripts/console b/scripts/console
index e3129a0d4..42c193ac1 100755
--- a/scripts/console
+++ b/scripts/console
@@ -39,8 +39,10 @@ package Devel::REPL;
 
 use utf8;
 use CGI qw( -no_xhtml);
+use DateTime;
 use SL::Auth;
 use SL::Form;
+use SL::Helper::DateTime;
 use SL::Locale;
 use SL::LXDebug;
 use Data::Dumper;
diff --git a/scripts/task_server.pl b/scripts/task_server.pl
new file mode 100755
index 000000000..2460e1b56
--- /dev/null
+++ b/scripts/task_server.pl
@@ -0,0 +1,146 @@
+#!/usr/bin/perl
+
+use strict;
+
+BEGIN {
+  require Cwd;
+
+  my $dir =  $0;
+  $dir    =  Cwd::getcwd() . '/' . $dir unless $dir =~ m|^/|;
+  $dir    =~ s|[^/]+$|..|;
+
+  chdir($dir) || die "Cannot change directory to ${dir}\n";
+
+  unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
+  push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
+}
+
+use CGI qw( -no_xhtml);
+use Config::Std;
+use Cwd;
+use Daemon::Generic;
+use Data::Dumper;
+use DateTime;
+use English qw(-no_match_vars);
+use POSIX qw(setuid setgid);
+use SL::Auth;
+use SL::DB::BackgroundJob;
+use SL::BackgroundJob::ALL;
+use SL::Form;
+use SL::Helper::DateTime;
+use SL::LXDebug;
+use SL::Locale;
+
+my %config;
+
+# this is a cleaned up version of am.pl
+# it lacks redirection, some html setup and most of the authentication process.
+# it is assumed that anyone with physical access and execution rights on this script
+# won't be hindered by authentication anyway.
+sub lxinit {
+  my $login = $config{task_server}->{login};
+
+  package main;
+
+  { no warnings 'once';
+    $::userspath  = "users";
+    $::templates  = "templates";
+    $::sendmail   = "| /usr/sbin/sendmail -t";
+  }
+
+  eval { require "config/lx-erp.conf";       1; } or die $EVAL_ERROR;
+  eval { require "config/lx-erp-local.conf"; 1; } or die $EVAL_ERROR if -f "config/lx-erp-local.conf";
+
+  $::lxdebug = LXDebug->new;
+  $::locale  = Locale->new($::language);
+  $::cgi     = CGI->new qw();
+  $::form    = Form->new;
+  $::auth    = SL::Auth->new;
+
+  die 'cannot reach auth db'               unless $::auth->session_tables_present;
+
+  $::auth->restore_session;
+
+  require "bin/mozilla/common.pl";
+
+  die "cannot find user $login"            unless %::myconfig = $::auth->read_user($login);
+  die "cannot find locale for user $login" unless $::locale   = Locale->new('de');
+}
+
+sub drop_privileges {
+  my $user = $::emmvee_conf{task_server}->{run_as};
+  return unless $user;
+
+  my ($uid, $gid);
+  while (my @details = getpwent()) {
+    next unless $details[0] eq $user;
+    ($uid, $gid) = @details[2, 3];
+    last;
+  }
+  endpwent();
+
+  if (!$uid) {
+    print "Error: Cannot drop privileges to ${user}: user does not exist\n";
+    exit 1;
+  }
+
+  if (!setgid($gid)) {
+    print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
+    exit 1;
+  }
+
+  if (!setuid($uid)) {
+    print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
+    exit 1;
+  }
+}
+
+sub gd_preconfig {
+  my $self = shift;
+
+  read_config $self->{configfile} => %config;
+
+  die "Missing section [task_server] in config file"                unless $config{task_server};
+  die "Missing key 'login' in section [task_server] in config file" unless $config{task_server}->{login};
+
+  drop_privileges();
+  lxinit();
+
+  return ();
+}
+
+sub gd_run {
+  while (1) {
+    my $ok = eval {
+      $::lxdebug->message(0, "Retrieving jobs") if $config{task_server}->{debug};
+
+      my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
+
+      $::lxdebug->message(0, "  Found: " . join(' ', map { $_->package_name } @{ $jobs })) if $config{task_server}->{debug} && @{ $jobs };
+
+      $_->run for @{ $jobs };
+
+      1;
+    };
+
+    if ($config{task_server}->{debug}) {
+      $::lxdebug->message(0, "Exception during execution: ${EVAL_ERROR}") if !$ok;
+      $::lxdebug->message(0, "Sleeping");
+    }
+
+    my $seconds = 60 - (localtime)[0];
+    sleep($seconds < 30 ? $seconds + 60 : $seconds);
+  }
+}
+
+my $cwd     = getcwd();
+my $pidbase = "${cwd}/users/pid";
+
+mkdir($pidbase) if !-d $pidbase;
+
+newdaemon(configfile => "${cwd}/config/task_server.conf",
+          progname   => 'lx-office-task-server',
+          pidbase    => "${pidbase}/",
+          );
+
+1;
diff --git a/sql/Pg-upgrade2/emmvee_background_jobs.sql b/sql/Pg-upgrade2/emmvee_background_jobs.sql
new file mode 100644
index 000000000..fff75c781
--- /dev/null
+++ b/sql/Pg-upgrade2/emmvee_background_jobs.sql
@@ -0,0 +1,29 @@
+-- @tag: emmvee_background_jobs
+-- @description: Tabellen für Hintergrundjobs
+-- @depends: release_2_6_1
+-- @charset: utf-8
+
+CREATE TABLE background_jobs (
+    id serial NOT NULL,
+    type character varying(255),
+    package_name character varying(255),
+    last_run_at timestamp without time zone,
+    next_run_at timestamp without time zone,
+    data text,
+    active boolean,
+    cron_spec character varying(255),
+
+    PRIMARY KEY (id)
+);
+
+CREATE TABLE background_job_histories (
+    id serial NOT NULL,
+    package_name character varying(255),
+    run_at timestamp without time zone,
+    status character varying(255),
+    result text,
+    error text,
+    data text,
+
+    PRIMARY KEY (id)
+);
diff --git a/sql/Pg-upgrade2/emmvee_background_jobs_2.pl b/sql/Pg-upgrade2/emmvee_background_jobs_2.pl
new file mode 100644
index 000000000..7d997eff3
--- /dev/null
+++ b/sql/Pg-upgrade2/emmvee_background_jobs_2.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+# @tag: emmvee_background_jobs_2
+# @description: Hintergrundjobs einrichten
+# @depends: emmvee_background_jobs
+# @charset: utf-8
+
+use strict;
+
+use SL::BackgroundJob::CleanBackgroundJobHistory;
+
+SL::BackgroundJob::CleanBackgroundJobHistory->create_job;
+
+1;
diff --git a/sql/Pg-upgrade2/periodic_invoices.sql b/sql/Pg-upgrade2/periodic_invoices.sql
new file mode 100644
index 000000000..e40cddc71
--- /dev/null
+++ b/sql/Pg-upgrade2/periodic_invoices.sql
@@ -0,0 +1,34 @@
+-- @tag: periodic_invoices
+-- @description: Neue Tabellen und Spalten für Wiederkehrende Rechnungen
+-- @depends: release_2_6_1
+CREATE TABLE periodic_invoices_configs (
+       id                      integer     NOT NULL DEFAULT nextval('id'),
+       oe_id                   integer     NOT NULL,
+       periodicity             varchar(10) NOT NULL,
+       print                   boolean               DEFAULT 'f',
+       printer_id              integer,
+       copies                  integer,
+       active                  boolean               DEFAULT 't',
+       terminated              boolean               DEFAULT 'f',
+       start_date              date,
+       end_date                date,
+       ar_chart_id             integer     NOT NULL,
+       extend_automatically_by integer,
+
+       PRIMARY KEY (id),
+       FOREIGN KEY (oe_id)       REFERENCES oe       (id),
+       FOREIGN KEY (printer_id)  REFERENCES printers (id),
+       FOREIGN KEY (ar_chart_id) REFERENCES chart    (id)
+);
+
+CREATE TABLE periodic_invoices (
+       id                integer   NOT NULL DEFAULT nextval('id'),
+       config_id         integer   NOT NULL,
+       ar_id             integer   NOT NULL,
+       period_start_date date      NOT NULL,
+       itime             timestamp          DEFAULT now(),
+
+       PRIMARY KEY (id),
+       FOREIGN KEY (config_id) REFERENCES periodic_invoices_configs (id),
+       FOREIGN KEY (ar_id)     REFERENCES ar                        (id)
+);
diff --git a/templates/webpages/oe/edit_periodic_invoices_config.html b/templates/webpages/oe/edit_periodic_invoices_config.html
new file mode 100644
index 000000000..c469a02ce
--- /dev/null
+++ b/templates/webpages/oe/edit_periodic_invoices_config.html
@@ -0,0 +1,107 @@
+[% USE HTML %]
+[% USE LxERP %]
+[% USE L %]
+<body>
+
+ <div class="listtop">[% title %]</div>
+
+ <form name="Form" action="oe.pl" method="post">
+
+  <p>
+   <table border="0">
+    <tr>
+     <th align="right">[% LxERP.t8('Status') %]</th>
+     <td>[% L.checkbox_tag("active", checked => active, label => LxERP.t8('Active')) %]</td>
+    </tr>
+
+    <tr>
+     <td>&nbsp;</td>
+     <td>
+      [% L.checkbox_tag('terminated', label => LxERP.t8('terminated'), checked => terminated) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right" valign="top">[%- LxERP.t8('Periodicity') %]</th>
+     <td valign="top">
+      [% L.radio_button_tag("periodicity", value => "m", label => LxERP.t8("monthly"),   checked => periodicity == 'm') %]
+      <br>
+      [% L.radio_button_tag("periodicity", value => "q", label => LxERP.t8("quarterly"), checked => periodicity == 'q') %]
+      <br>
+      [% L.radio_button_tag("periodicity", value => "y", label => LxERP.t8("yearly"),    checked => periodicity == 'y') %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[%- LxERP.t8('Start date') %]</th>
+     <td valign="top">
+      [% L.date_tag("start_date_as_date", start_date_as_date) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[%- LxERP.t8('End date') %]<sup>(1)</sup></th>
+     <td valign="top">
+      [% L.date_tag("end_date_as_date", end_date_as_date) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[% LxERP.t8('Extend automatically by n months') %]</th>
+     <td valign="top">
+      [% L.input_tag("extend_automatically_by", extend_automatically_by, size => 10) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[%- LxERP.t8('Record in') %]</th>
+     <td valign="top">
+      [% L.select_tag("ar_chart_id", L.options_for_select(AR, title => 'description', default => ar_chart_id)) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[%- LxERP.t8('Print automatically') %]</th>
+     <td valign="top">
+      [% L.checkbox_tag("print", onclick => "toggle_printer_id_ctrl()", checked => print) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[%- LxERP.t8('Printer') %]</th>
+     <td valign="top">
+      [% L.select_tag("printer_id", L.options_for_select(ALL_PRINTERS, title => 'printer_description', default => printer_id), disabled => !print) %]
+     </td>
+    </tr>
+
+    <tr>
+     <th align="right">[%- LxERP.t8('Copies') %]</th>
+     <td valign="top">[% L.input_tag("copies", copies, size => 6, disabled => !print) %]</td>
+    </tr>
+   </table>
+  </p>
+
+  <hr>
+
+  <p>(1): [%- LxERP.t8('The end date is the last day for which invoices will possibly be created.') %]</p>
+
+  [% L.hidden_tag('action', 'save_periodic_invoices_config') %]
+
+  <p>
+   [% L.submit_tag('', LxERP.t8('Close')) %]
+   [% L.submit_tag('', LxERP.t8('Cancel'), onclick => "self.close(); return false;") %]
+  </p>
+ </form>
+
+ <script type="text/javascript">
+  <!--
+    function toggle_printer_id_ctrl() {
+      var disabled = !$('#print').attr('checked');
+      $('#printer_id').attr('disabled', disabled);
+      $('#copies').attr('disabled', disabled);
+    }
+    -->
+ </script>
+
+</body>
+</html>
diff --git a/templates/webpages/oe/form_footer.html b/templates/webpages/oe/form_footer.html
index 5af01028b..b0ba7fe67 100644
--- a/templates/webpages/oe/form_footer.html
+++ b/templates/webpages/oe/form_footer.html
@@ -1,6 +1,7 @@
 [%- USE T8 %]
 [%- USE HTML %]
 [%- USE LxERP %]
+[%- USE L %]
   <tr>
     <td>
       <table width="100%">
@@ -27,6 +28,18 @@
                            show_empty = 1 -%]
                 </td>
             </tr>
+
+[%- IF is_sales_ord %]
+            <tr>
+             <th align="right">[%- LxERP.t8('Periodic Invoices') %]</th>
+             <td>
+              [% L.button_tag("edit_periodic_invoices_config(); return false;", LxERP.t8('Configure')) %]
+              ([% HTML.escape(periodic_invoices_status) %])
+              [% L.hidden_tag("periodic_invoices_config", periodic_invoices_config) %]
+             </td>
+            </tr>
+[%- END %]
+
       [%- IF id && num_follow_ups %]
       <tr>
        <td colspan="2">[% LxERP.t8('There are #1 unfinished follow-ups of which #2 are due.', num_follow_ups, num_due_follow_ups) %]</td>
diff --git a/templates/webpages/oe/form_header.html b/templates/webpages/oe/form_header.html
index 87555df39..e3f3e1d30 100644
--- a/templates/webpages/oe/form_header.html
+++ b/templates/webpages/oe/form_header.html
@@ -1,6 +1,7 @@
 [%- USE T8 %]
 [%- USE HTML %]
 [%- USE LxERP %]
+[%- USE L %]
 <body onLoad="[% onload %]">
 
   <form method="post" name="oe" action="[% script %]">
@@ -11,6 +12,9 @@
     <script type="text/javascript" src="js/calculate_qty.js"></script>
     <script type="text/javascript" src="js/customer_or_vendor_selection.js"></script>
     <script type="text/javascript" src="js/follow_up.js"></script>
+    [%- IF is_sales_ord %]
+     [% L.javascript_tag("js/edit_periodic_invoices_config") %]
+    [%- END %]
 
 [%- FOREACH row = HIDDENS %]
    <input type="hidden" name="[% HTML.escape(row.name) %]" value="[% HTML.escape(row.value) %]" >
diff --git a/templates/webpages/oe/periodic_invoices_email.txt b/templates/webpages/oe/periodic_invoices_email.txt
new file mode 100644
index 000000000..56b3e5a78
--- /dev/null
+++ b/templates/webpages/oe/periodic_invoices_email.txt
@@ -0,0 +1,9 @@
+Sehr geehrter Benutzer,
+
+die folgenden wiederkehrenden Rechnungen wurden automatisch erzeugt:
+
+[% FOREACH inv = NEW_INVNUMBERS %][% inv.number %] [% END %]
+
+Davon wurden die folgenden Rechnungen automatisch ausgedruckt:
+
+[% FOREACH inv = PRINTED_INVNUMBERS %][% inv.number %] [% END %]
diff --git a/templates/webpages/oe/save_periodic_invoices_config.html b/templates/webpages/oe/save_periodic_invoices_config.html
new file mode 100644
index 000000000..81818fec0
--- /dev/null
+++ b/templates/webpages/oe/save_periodic_invoices_config.html
@@ -0,0 +1,19 @@
+[% USE HTML %]
+[% USE L %]
+<body onload="copy_values_and_close()">
+
+ <script type="text/javascript">
+  <!--
+      function copy_values_and_close() {
+        window.opener.document.getElementsByName("periodic_invoices_config")[0].value = $("#periodic_invoices_config").attr('value');
+        window.close();
+      }
+    -->
+ </script>
+
+ <form name="Form">
+  [% L.hidden_tag("periodic_invoices_config", periodic_invoices_config) %]
+ </form>
+
+</body>
+</html>
diff --git a/templates/webpages/oe/search.html b/templates/webpages/oe/search.html
index 90cb60252..788a1a283 100644
--- a/templates/webpages/oe/search.html
+++ b/templates/webpages/oe/search.html
@@ -1,6 +1,7 @@
 [%- USE HTML %]
 [%- USE T8 %]
 [%- USE LxERP %]
+[%- USE L %]
 [%- SET vclabel = vc == 'customer' ? LxERP.t8('Customer') : LxERP.t8('Vendor') %]
 [%- SET vcnumberlabel = vc == 'customer' ? LxERP.t8('Customer Number') : LxERP.t8('Vendor Number') %]
 <body>
@@ -150,6 +151,16 @@
          <label for="delivered">[% 'Delivered' | $T8 %]</label>
         </td>
        </tr>
+[%- END %]
+[%- IF type == 'sales_order' %]
+       <tr>
+        <td>
+         [% L.checkbox_tag("periodic_invoices_active", label => LxERP.t8("Periodic invoices active")) %]
+        </td>
+        <td>
+         [% L.checkbox_tag("periodic_invoices_inactive", label => LxERP.t8("Periodic invoices inactive")) %]
+        </td>
+       </tr>
 [%- END %]
        <tr>
         <td>