Revision 7866dd56
Von Tamino Steinert vor mehr als 2 Jahren hinzugefügt
| t/Support/TestRoutines.pm | ||
|---|---|---|
| package Support::TestRoutines;
 | ||
|  | ||
| use Test::More;
 | ||
| use List::MoreUtils qw(any);
 | ||
|  | ||
| require Exporter;
 | ||
| our @ISA = qw(Exporter);
 | ||
|  | ||
| our @EXPORT = qw(test_deeply);
 | ||
|  | ||
| sub test_deeply {
 | ||
|   my ($first, $second, $description, @ignore_keys) = @_;
 | ||
|  | ||
|   my @first_keys = keys %{$first};
 | ||
|   my @second_keys = keys %{$second};
 | ||
|   foreach my $key (@first_keys) {
 | ||
|     if (!any { $_ eq $key } @ignore_keys) {
 | ||
|       if (!any { $_ eq $key } @second_keys) {
 | ||
|         ok(0, $description . ": " . $key);
 | ||
|       }
 | ||
|     }
 | ||
|   }
 | ||
|   foreach my $key (@second_keys) {
 | ||
|     if (!any { $_ eq $key } @ignore_keys) {
 | ||
|       if (!any { $_ eq $key } @first_keys) {
 | ||
|         ok(0, $description . ": " . $key);
 | ||
|       } else {
 | ||
|         is($first->{$key}, $second->{$key}, $description . ": " . $key);
 | ||
|       }
 | ||
|     }
 | ||
|   }
 | ||
| }
 | ||
|  | ||
| t/workflow/delivery_order_reclamation.t | ||
|---|---|---|
|  | ||
| use Carp;
 | ||
| use Data::Dumper;
 | ||
| use Data::Compare;
 | ||
| use Support::TestSetup;
 | ||
| use Support::TestRoutines qw(test_deeply);
 | ||
| use Test::Exception;
 | ||
| use List::Util qw(zip);
 | ||
| use List::MoreUtils qw(pairwise);
 | ||
|  | ||
| use SL::DB::DeliveryOrder;
 | ||
| use SL::DB::Reclamation;
 | ||
| ... | ... | |
|  | ||
|  | ||
| #get items before strip
 | ||
| my @purchase_reclamation_items = $purchase_reclamation->items_sorted;
 | ||
| my @sales_reclamation_items    = $sales_reclamation->items_sorted;
 | ||
| my @converted_purchase_reclamation_items = $converted_purchase_reclamation->items_sorted;
 | ||
| my @converted_sales_reclamation_items    = $converted_sales_reclamation->items_sorted;
 | ||
| my @purchase_delivery_order_items = $purchase_delivery_order->items_sorted;
 | ||
| my @sales_delivery_order_items    = $sales_delivery_order->items_sorted;
 | ||
| my @converted_purchase_delivery_order_items = $converted_purchase_delivery_order->items_sorted;
 | ||
| my @converted_sales_delivery_order_items    = $converted_sales_delivery_order->items_sorted;
 | ||
| my @purchase_reclamation_items              = @{$purchase_reclamation->items_sorted};
 | ||
| my @sales_reclamation_items                 = @{$sales_reclamation->items_sorted};
 | ||
| my @converted_purchase_reclamation_items    = @{$converted_purchase_reclamation->items_sorted};
 | ||
| my @converted_sales_reclamation_items       = @{$converted_sales_reclamation->items_sorted};
 | ||
| my @purchase_delivery_order_items           = @{$purchase_delivery_order->items_sorted};
 | ||
| my @sales_delivery_order_items              = @{$sales_delivery_order->items_sorted};
 | ||
| my @converted_purchase_delivery_order_items = @{$converted_purchase_delivery_order->items_sorted};
 | ||
| my @converted_sales_delivery_order_items    = @{$converted_sales_delivery_order->items_sorted};
 | ||
|  | ||
|  | ||
| ### TESTS #####################################################################
 | ||
| ... | ... | |
|   $sales_reclamation_tmp->$_(undef);
 | ||
|   $purchase_reclamation_tmp->$_(undef);
 | ||
| }
 | ||
| foreach my $pair (zip(@purchase_reclamation_items, @sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise  { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_reclamation_items, @sales_reclamation_items;
 | ||
| is_deeply($purchase_reclamation_tmp->strip->as_tree, $sales_reclamation_tmp->strip->as_tree);
 | ||
|  | ||
| ## created sales und purchase delivery_order should be nearly the same
 | ||
| ... | ... | |
|   $sales_delivery_order_tmp->$_(undef);
 | ||
|   $purchase_delivery_order_tmp->$_(undef);
 | ||
| }
 | ||
| foreach my $pair (zip(@purchase_delivery_order_items, @sales_delivery_order_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise  { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id delivery_order_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_delivery_order_items, @sales_delivery_order_items;
 | ||
| is_deeply($purchase_delivery_order_tmp->strip->as_tree, $sales_delivery_order_tmp->strip->as_tree);
 | ||
|  | ||
|  | ||
| ... | ... | |
|  | ||
| ## converted should be nealy the same
 | ||
| # sales
 | ||
| foreach my $pair (zip(@sales_delivery_order_items, @converted_sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id delivery_order_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_price_factor ordnumber transdate
 | ||
|         description reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($sales_delivery_order->strip->as_tree, $converted_sales_reclamation->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime reqdate
 | ||
|       is_sales order_type ordnumber oreqnumber
 | ||
|       amount exchangerate netamount
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       donumber record_number
 | ||
|       )]});
 | ||
|  | ||
| foreach my $pair (zip(@sales_reclamation_items, @converted_sales_delivery_order_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id delivery_order_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_price_factor ordnumber transdate
 | ||
|         description reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($sales_reclamation->strip->as_tree, $converted_sales_delivery_order->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime delivered reqdate
 | ||
|       is_sales order_type ordnumber oreqnumber
 | ||
|       amount exchangerate netamount
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       donumber record_number
 | ||
|       )]});
 | ||
| pairwise  {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "sales_delivery_order_items to sales_reclamation_items",
 | ||
|     qw(
 | ||
|       id delivery_order_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_price_factor ordnumber transdate
 | ||
|       description reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @sales_delivery_order_items, @converted_sales_reclamation_items;
 | ||
| test_deeply($sales_delivery_order->strip->as_tree, $converted_sales_reclamation->strip->as_tree,
 | ||
|   "sales_delivery_order to sales_reclamation",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime reqdate
 | ||
|     is_sales order_type ordnumber oreqnumber
 | ||
|     amount exchangerate netamount
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     donumber record_number
 | ||
|   ));
 | ||
|  | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "sales_reclamation_items to sales_delivery_order_items",
 | ||
|     qw(
 | ||
|       id delivery_order_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_price_factor ordnumber transdate
 | ||
|       description reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @sales_reclamation_items, @converted_sales_delivery_order_items;
 | ||
| test_deeply($sales_reclamation->strip->as_tree, $converted_sales_delivery_order->strip->as_tree,
 | ||
|   "sales_reclamation to sales_delivery_order",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime delivered reqdate
 | ||
|     is_sales order_type ordnumber oreqnumber
 | ||
|     amount exchangerate netamount
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     donumber record_number
 | ||
|   ));
 | ||
|  | ||
|  | ||
| # purchase
 | ||
| foreach my $pair (zip(@purchase_delivery_order_items, @converted_purchase_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id delivery_order_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_price_factor ordnumber transdate
 | ||
|         description reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($purchase_delivery_order->strip->as_tree, $converted_purchase_reclamation->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime reqdate
 | ||
|       is_sales order_type ordnumber oreqnumber
 | ||
|       amount exchangerate netamount
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       donumber record_number
 | ||
|       )]});
 | ||
|  | ||
| foreach my $pair (zip(@purchase_reclamation_items, @converted_purchase_delivery_order_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id delivery_order_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_price_factor ordnumber transdate
 | ||
|         description reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($purchase_reclamation->strip->as_tree, $converted_purchase_delivery_order->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime delivered reqdate
 | ||
|       is_sales order_type ordnumber oreqnumber
 | ||
|       amount exchangerate netamount
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       donumber record_number
 | ||
|       )]});
 | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "purchase_delivery_order_items to purchase_reclamation_items",
 | ||
|     qw(
 | ||
|       id delivery_order_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_price_factor ordnumber transdate
 | ||
|       description reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @purchase_delivery_order_items, @converted_purchase_reclamation_items;
 | ||
| test_deeply($purchase_delivery_order->strip->as_tree, $converted_purchase_reclamation->strip->as_tree,
 | ||
|   "purchase_delivery_order to purchase_reclamation",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime reqdate
 | ||
|     is_sales order_type ordnumber oreqnumber
 | ||
|     amount exchangerate netamount
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     donumber record_number
 | ||
|   ));
 | ||
|  | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "purchase_reclamation_items to purchase_delivery_order_items",
 | ||
|     qw(
 | ||
|       id delivery_order_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_price_factor ordnumber transdate
 | ||
|       description reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @purchase_reclamation_items, @converted_purchase_delivery_order_items;
 | ||
| test_deeply($purchase_reclamation->strip->as_tree, $converted_purchase_delivery_order->strip->as_tree,
 | ||
|   "purchase_reclamation to purchase_delivery_order",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime delivered reqdate
 | ||
|     is_sales order_type ordnumber oreqnumber
 | ||
|     amount exchangerate netamount
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     donumber record_number
 | ||
|   ));
 | ||
|  | ||
|  | ||
|  | ||
| t/workflow/invoice_to_reclamation.t | ||
|---|---|---|
|  | ||
| use Carp;
 | ||
| use Data::Dumper;
 | ||
| use Data::Compare;
 | ||
| use Support::TestSetup;
 | ||
| use Support::TestRoutines qw(test_deeply);
 | ||
| use Test::Exception;
 | ||
| use List::Util qw(zip);
 | ||
| use List::MoreUtils qw(pairwise);
 | ||
|  | ||
| use SL::DB::Order;
 | ||
| use SL::DB::Reclamation;
 | ||
| ... | ... | |
| $converted_purchase_reclamation->save->load;
 | ||
|  | ||
| #get items before strip
 | ||
| my @purchase_reclamation_items = $purchase_reclamation->items_sorted;
 | ||
| my @sales_reclamation_items    = $sales_reclamation->items_sorted;
 | ||
| my @converted_purchase_reclamation_items = $converted_purchase_reclamation->items_sorted;
 | ||
| my @converted_sales_reclamation_items    = $converted_sales_reclamation->items_sorted;
 | ||
| my @purchase_invoice_items = $purchase_invoice->items_sorted;
 | ||
| my @sales_invoice_items    = $sales_invoice->items_sorted;
 | ||
| my @purchase_reclamation_items           = @{$purchase_reclamation->items_sorted};
 | ||
| my @sales_reclamation_items              = @{$sales_reclamation->items_sorted};
 | ||
| my @converted_purchase_reclamation_items = @{$converted_purchase_reclamation->items_sorted};
 | ||
| my @converted_sales_reclamation_items    = @{$converted_sales_reclamation->items_sorted};
 | ||
| my @purchase_invoice_items               = @{$purchase_invoice->items_sorted};
 | ||
| my @sales_invoice_items                  = @{$sales_invoice->items_sorted};
 | ||
|  | ||
|  | ||
| ### TESTS #####################################################################
 | ||
| ... | ... | |
|   $sales_reclamation_tmp->$_(undef);
 | ||
|   $purchase_reclamation_tmp->$_(undef);
 | ||
| }
 | ||
| foreach my $pair (zip(@purchase_reclamation_items, @sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_reclamation_items, @sales_reclamation_items;
 | ||
| is_deeply($purchase_reclamation_tmp->strip->as_tree, $sales_reclamation_tmp->strip->as_tree);
 | ||
|  | ||
| ## converted have to be linked to parent
 | ||
| ... | ... | |
|  | ||
|  | ||
| ## converted should be nealy the same
 | ||
| foreach my $pair (zip(@sales_invoice_items, @converted_sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id trans_id reclamation_id itime mtime
 | ||
|         allocated assemblyitem cusordnumber deliverydate donumber fxsellprice marge_percent marge_price_factor marge_total optional ordnumber subtotal transdate
 | ||
|         reason_description_ext reason_description_int reason_id reqdate
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($sales_invoice->strip->as_tree, $converted_sales_reclamation->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime transdate
 | ||
|       datepaid delivery_customer_id delivery_vendor_id deliverydate direct_debit donumber duedate dunning_config_id gldate invnumber_for_credit_note invoice marge_percent marge_total orddate ordnumber paid qr_reference qr_unstructured_message qrbill_without_amount quodate quonumber storno storno_id type
 | ||
|       delivered closed exchangerate reqdate vendor_id
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       invnumber record_number
 | ||
|       )]});
 | ||
|  | ||
| foreach my $pair (zip(@purchase_invoice_items, @converted_purchase_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id trans_id reclamation_id itime mtime
 | ||
|         allocated assemblyitem cusordnumber deliverydate donumber fxsellprice marge_percent marge_price_factor marge_total optional ordnumber subtotal transdate
 | ||
|         reason_description_ext reason_description_int reason_id reqdate
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($purchase_invoice->strip->as_tree, $converted_purchase_reclamation->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime transdate
 | ||
|       datepaid deliverydate direct_debit duedate gldate invoice orddate ordnumber paid quodate quonumber storno storno_id type
 | ||
|       billing_address_id customer_id cv_record_number delivered closed exchangerate reqdate salesman_id shippingpoint shipto_id
 | ||
|       cp_id contact_id
 | ||
|       invnumber record_number
 | ||
|       )]});
 | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "sales_invoice_items to sales_reclamation_items",
 | ||
|     qw(
 | ||
|       id trans_id reclamation_id itime mtime
 | ||
|       allocated assemblyitem cusordnumber deliverydate donumber fxsellprice marge_percent marge_price_factor marge_total optional ordnumber subtotal transdate
 | ||
|       reason_description_ext reason_description_int reason_id reqdate
 | ||
|     ));
 | ||
| } @sales_invoice_items, @converted_sales_reclamation_items;
 | ||
| test_deeply($sales_invoice->strip->as_tree, $converted_sales_reclamation->strip->as_tree,
 | ||
|   "sales_invoice to sales_reclamation",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime transdate
 | ||
|     datepaid delivery_customer_id delivery_vendor_id deliverydate direct_debit donumber duedate dunning_config_id gldate invnumber_for_credit_note invoice marge_percent marge_total orddate ordnumber paid qr_reference qr_unstructured_message qrbill_without_amount quodate quonumber storno storno_id type
 | ||
|     delivered closed exchangerate reqdate vendor_id
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     invnumber record_number
 | ||
|   ));
 | ||
|  | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "purchase_invoice_items to purchase_reclamation_items",
 | ||
|     qw(
 | ||
|       id trans_id reclamation_id itime mtime
 | ||
|       allocated assemblyitem cusordnumber deliverydate donumber fxsellprice marge_percent marge_price_factor marge_total optional ordnumber subtotal transdate
 | ||
|       reason_description_ext reason_description_int reason_id reqdate
 | ||
|     ));
 | ||
| } @purchase_invoice_items, @converted_purchase_reclamation_items;
 | ||
| test_deeply($purchase_invoice->strip->as_tree, $converted_purchase_reclamation->strip->as_tree,
 | ||
|   "purchase_invoice to purchase_reclamation",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime transdate
 | ||
|     datepaid deliverydate direct_debit duedate gldate invoice orddate ordnumber paid quodate quonumber storno storno_id type is_sepa_blocked
 | ||
|     billing_address_id customer_id cv_record_number delivered closed exchangerate reqdate salesman_id shippingpoint shipto_id
 | ||
|     cp_id contact_id
 | ||
|     invnumber record_number
 | ||
|   ));
 | ||
|  | ||
| # diag Dumper($sales_invoice->strip->as_tree);
 | ||
| # diag Dumper($converted_sales_reclamation->strip->as_tree);
 | ||
| t/workflow/order_reclamation.t | ||
|---|---|---|
|  | ||
| use Carp;
 | ||
| use Data::Dumper;
 | ||
| use Data::Compare;
 | ||
| use Support::TestSetup;
 | ||
| use Support::TestRoutines qw(test_deeply);
 | ||
| use Test::Exception;
 | ||
| use List::Util qw(zip);
 | ||
| use List::MoreUtils qw(pairwise);
 | ||
|  | ||
| use SL::DB::Order;
 | ||
| use SL::DB::Reclamation;
 | ||
| ... | ... | |
|  | ||
|  | ||
| #get items before strip
 | ||
| my @purchase_reclamation_items = $purchase_reclamation->items_sorted;
 | ||
| my @sales_reclamation_items    = $sales_reclamation->items_sorted;
 | ||
| my @converted_purchase_reclamation_items = $converted_purchase_reclamation->items_sorted;
 | ||
| my @converted_sales_reclamation_items    = $converted_sales_reclamation->items_sorted;
 | ||
| my @purchase_order_items = $purchase_order->items_sorted;
 | ||
| my @sales_order_items    = $sales_order->items_sorted;
 | ||
| my @converted_purchase_order_items = $converted_purchase_order->items_sorted;
 | ||
| my @converted_sales_order_items    = $converted_sales_order->items_sorted;
 | ||
| my @purchase_reclamation_items           = @{$purchase_reclamation->items_sorted};
 | ||
| my @sales_reclamation_items              = @{$sales_reclamation->items_sorted};
 | ||
| my @converted_purchase_reclamation_items = @{$converted_purchase_reclamation->items_sorted};
 | ||
| my @converted_sales_reclamation_items    = @{$converted_sales_reclamation->items_sorted};
 | ||
| my @purchase_order_items                 = @{$purchase_order->items_sorted};
 | ||
| my @sales_order_items                    = @{$sales_order->items_sorted};
 | ||
| my @converted_purchase_order_items       = @{$converted_purchase_order->items_sorted};
 | ||
| my @converted_sales_order_items          = @{$converted_sales_order->items_sorted};
 | ||
|  | ||
|  | ||
| ### TESTS #####################################################################
 | ||
| ... | ... | |
|   $sales_reclamation_tmp->$_(undef);
 | ||
|   $purchase_reclamation_tmp->$_(undef);
 | ||
| }
 | ||
| foreach my $pair (zip(@purchase_reclamation_items, @sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
|  | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_reclamation_items, @sales_reclamation_items;
 | ||
| is_deeply($purchase_reclamation_tmp->strip->as_tree, $sales_reclamation_tmp->strip->as_tree);
 | ||
|  | ||
| ## created sales und purchase order should be nearly the same
 | ||
| ... | ... | |
|   $sales_order_tmp->$_(undef);
 | ||
|   $purchase_order_tmp->$_(undef);
 | ||
| }
 | ||
| foreach my $pair (zip(@purchase_order_items, @sales_order_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id trans_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_order_items, @sales_order_items;
 | ||
| is_deeply($purchase_order_tmp->strip->as_tree, $sales_order_tmp->strip->as_tree);
 | ||
|  | ||
|  | ||
| ... | ... | |
|  | ||
| ## converted should be nealy the same
 | ||
| # sales
 | ||
| foreach my $pair (zip(@sales_order_items, @converted_sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id trans_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|         reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($sales_order->strip->as_tree, $converted_sales_reclamation->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime reqdate transdate
 | ||
|       delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       ordnumber record_number
 | ||
|       )]});
 | ||
|  | ||
| foreach my $pair (zip(@sales_reclamation_items, @converted_sales_order_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id trans_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|         reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($sales_reclamation->strip->as_tree, $converted_sales_order->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime reqdate transdate
 | ||
|       delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       ordnumber record_number
 | ||
|       )]});
 | ||
| pairwise {
 | ||
|   test_deeply( $a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "sales_order_items to sales_reclamation_items",
 | ||
|     qw(
 | ||
|       id trans_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|       reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @sales_order_items, @converted_sales_reclamation_items;
 | ||
| test_deeply( $sales_order->strip->as_tree, $converted_sales_reclamation->strip->as_tree,
 | ||
|   "sales_order to sales_reclamation",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime reqdate transdate
 | ||
|     delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     ordnumber record_number
 | ||
|   ));
 | ||
|  | ||
| pairwise {
 | ||
|   test_deeply( $a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "sales_reclamation_items to sales_order_items",
 | ||
|     qw(
 | ||
|       id trans_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|       reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @sales_reclamation_items, @converted_sales_order_items;
 | ||
| test_deeply($sales_reclamation->strip->as_tree, $converted_sales_order->strip->as_tree,
 | ||
|   "sales_reclamation to sales_order",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime reqdate transdate
 | ||
|     delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     ordnumber record_number
 | ||
|   ));
 | ||
|  | ||
| # purchase
 | ||
| foreach my $pair (zip(@purchase_order_items, @converted_purchase_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id trans_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|         reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($purchase_order->strip->as_tree, $converted_purchase_reclamation->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime reqdate transdate
 | ||
|       delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       ordnumber record_number
 | ||
|       )]});
 | ||
|  | ||
| foreach my $pair (zip(@purchase_reclamation_items, @converted_purchase_order_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   ok Compare($first->strip->as_tree, $second->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|         id trans_id reclamation_id itime mtime
 | ||
|         cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|         reason_description_ext reason_description_int reason_id
 | ||
|       )]});
 | ||
| }
 | ||
| ok Compare($purchase_reclamation->strip->as_tree, $converted_purchase_order->strip->as_tree, {ignore_hash_keys => [qw(
 | ||
|       id employee_id itime mtime reqdate transdate
 | ||
|       delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|       cp_id contact_id
 | ||
|       cusordnumber cv_record_number
 | ||
|       ordnumber record_number
 | ||
|       )]});
 | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "purchase_order_items to purchase_reclamation_items",
 | ||
|     qw(
 | ||
|       id trans_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|       reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @purchase_order_items, @converted_purchase_reclamation_items;
 | ||
| test_deeply($purchase_order->strip->as_tree, $converted_purchase_reclamation->strip->as_tree,
 | ||
|   "purchase_order to purchase_reclamation",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime reqdate transdate
 | ||
|     delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     ordnumber record_number
 | ||
|   ));
 | ||
|  | ||
| pairwise {
 | ||
|   test_deeply($a->strip->as_tree, $b->strip->as_tree,
 | ||
|     "purchase_reclamation_items to purchase_order_items",
 | ||
|     qw(
 | ||
|       id trans_id reclamation_id itime mtime
 | ||
|       cusordnumber marge_percent marge_price_factor marge_total optional ordnumber ship subtotal transdate
 | ||
|       reason_description_ext reason_description_int reason_id
 | ||
|     ));
 | ||
| } @purchase_reclamation_items, @converted_purchase_order_items;
 | ||
| test_deeply($purchase_reclamation->strip->as_tree, $converted_purchase_order->strip->as_tree,
 | ||
|   "purchase_reclamation to purchase_order",
 | ||
|   qw(
 | ||
|     id employee_id itime mtime reqdate transdate
 | ||
|     delivery_customer_id delivery_vendor_id expected_billing_date marge_percent marge_total order_probability order_status_id proforma quonumber quotation
 | ||
|     cp_id contact_id
 | ||
|     cusordnumber cv_record_number
 | ||
|     ordnumber record_number
 | ||
|   ));
 | ||
|  | ||
| # diag Dumper($sales_order->strip->as_tree);
 | ||
| # diag Dumper($converted_sales_reclamation->strip->as_tree);
 | ||
| t/workflow/reclamation_reclamation.t | ||
|---|---|---|
| use Data::Dumper;
 | ||
| use Support::TestSetup;
 | ||
| use Test::Exception;
 | ||
| use List::Util qw(zip);
 | ||
| use List::MoreUtils qw(pairwise);
 | ||
|  | ||
| use SL::DB::Reclamation;
 | ||
| use SL::DB::ReclamationReason;
 | ||
| ... | ... | |
| $converted_sales_reclamation->save->load;
 | ||
|  | ||
| #get items before strip
 | ||
| my @purchase_reclamation_items = $purchase_reclamation->items_sorted;
 | ||
| my @sales_reclamation_items    = $sales_reclamation->items_sorted;
 | ||
| my @new_purchase_reclamation_items = $new_purchase_reclamation->items_sorted;
 | ||
| my @new_sales_reclamation_items    = $new_sales_reclamation->items_sorted;
 | ||
| my @converted_purchase_reclamation_items = $converted_purchase_reclamation->items_sorted;
 | ||
| my @converted_sales_reclamation_items    = $converted_sales_reclamation->items_sorted;
 | ||
| my @purchase_reclamation_items           = @{$purchase_reclamation->items_sorted};
 | ||
| my @sales_reclamation_items              = @{$sales_reclamation->items_sorted};
 | ||
| my @new_purchase_reclamation_items       = @{$new_purchase_reclamation->items_sorted};
 | ||
| my @new_sales_reclamation_items          = @{$new_sales_reclamation->items_sorted};
 | ||
| my @converted_purchase_reclamation_items = @{$converted_purchase_reclamation->items_sorted};
 | ||
| my @converted_sales_reclamation_items    = @{$converted_sales_reclamation->items_sorted};
 | ||
|  | ||
|  | ||
| ### TESTS #####################################################################
 | ||
| ... | ... | |
|   $purchase_tmp->$_(undef);
 | ||
| }
 | ||
|  | ||
| foreach my $pair (zip(@purchase_reclamation_items, @sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_reclamation_items, @sales_reclamation_items;
 | ||
| is_deeply($purchase_tmp->strip->as_tree, $sales_tmp->strip->as_tree);
 | ||
|  | ||
|  | ||
| ... | ... | |
|   $purchase_tmp2->$_(undef);
 | ||
| }
 | ||
|  | ||
| foreach my $pair (zip(@sales_reclamation_items, @new_sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @sales_reclamation_items, @new_sales_reclamation_items;
 | ||
| is_deeply($sales_tmp2->strip->as_tree, $new_sales_tmp->strip->as_tree);
 | ||
|  | ||
| foreach my $pair (zip(@purchase_reclamation_items, @new_purchase_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     itime mtime
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_reclamation_items, @new_purchase_reclamation_items;
 | ||
| is_deeply($purchase_tmp2->strip->as_tree, $new_purchase_tmp->strip->as_tree);
 | ||
|  | ||
|  | ||
| ... | ... | |
| }
 | ||
|  | ||
| # from sales to purchase
 | ||
| foreach my $pair (zip(@sales_reclamation_items, @converted_purchase_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     sellprice discount
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @sales_reclamation_items, @converted_purchase_reclamation_items;
 | ||
| is_deeply($sales_tmp3->strip->as_tree, $converted_purchase_tmp->strip->as_tree);
 | ||
|  | ||
|  | ||
| # from purchase to sales
 | ||
| foreach my $pair (zip(@purchase_reclamation_items, @converted_sales_reclamation_items)) {
 | ||
|   my ($first, $second) = @{$pair};
 | ||
|   my $first_tmp = clone($first);
 | ||
|   my $second_tmp = clone($second);
 | ||
| pairwise { my $first_tmp = clone($a); my $second_tmp = clone($b);
 | ||
|   foreach (qw(
 | ||
|     id reclamation_id
 | ||
|     lastcost
 | ||
| ... | ... | |
|     $second_tmp->$_(undef);
 | ||
|   }
 | ||
|   is_deeply($first_tmp->strip->as_tree, $second_tmp->strip->as_tree);
 | ||
| }
 | ||
| } @purchase_reclamation_items, @converted_sales_reclamation_items;
 | ||
| is_deeply($purchase_tmp3->strip->as_tree, $converted_sales_tmp->strip->as_tree);
 | ||
|  | ||
| #diag Dumper($first->strip->as_tree);
 | ||
Auch abrufbar als: Unified diff
Reclamation: Test überarbeitet; test_deeply in Support::TestRoutines