SL/DB/Shipto.pm

   1 package SL::DB::Shipto;
   2
   3 use strict;
   4
   5 use Carp;
   6 use List::MoreUtils qw(all);
   7
   8 use SL::Util qw(trim);
   9
  10 use SL::DB::MetaSetup::Shipto;
  11 use SL::DB::Manager::Shipto;
  12 use SL::DB::Helper::CustomVariables (
  13   module      => 'ShipTo',
  14   cvars_alias => 1,
  15 );
  16
  17 our @SHIPTO_VARIABLES = qw(shiptoname shiptostreet shiptozipcode shiptocity shiptocountry shiptogln shiptocontact
  18                            shiptophone shiptofax shiptoemail shiptodepartment_1 shiptodepartment_2);
  19
  20 __PACKAGE__->meta->initialize;
  21
  22
  23 sub displayable_id {
  24   my $self = shift;
  25   my $text = join('; ', grep { $_ } (map({ $self->$_ } qw(shiptoname shiptostreet)),
  26                                      join(' ', grep { $_ }
  27                                                map  { $self->$_ }
  28                                                qw(shiptozipcode shiptocity))));
  29
  30   return $text;
  31 }
  32
  33 sub used {
  34   my ($self) = @_;
  35
  36   return unless $self->shipto_id;
  37
  38   require SL::DB::Order;
  39   require SL::DB::Invoice;
  40   require SL::DB::DeliveryOrder;
  41
  42   return SL::DB::Manager::Order->get_all_count(query => [ shipto_id => $self->shipto_id ])
  43       || SL::DB::Manager::Invoice->get_all_count(query => [ shipto_id => $self->shipto_id ])
  44       || SL::DB::Manager::DeliveryOrder->get_all_count(query => [ shipto_id => $self->shipto_id ]);
  45 }
  46
  47 sub is_empty {
  48   my ($self) = @_;
  49
  50   # todo: consider cvars
  51   my @fields_to_consider = grep { !m{^ (?: itime | mtime | shipto_id | trans_id | shiptocp_gender | module ) $}x } map {$_->name} $self->meta->columns;
  52
  53   return all { trim($self->$_) eq '' } @fields_to_consider;
  54 }
  55
  56 sub detach {
  57   $_[0]->trans_id(undef);
  58   $_[0];
  59 }
  60
  61 sub clone {
  62   my ($self, $target) = @_;
  63
  64   my $type   = ref($target) || $target;
  65   my $module = $type =~ m{::Order$}               ? 'OE'
  66              : $type =~ m{::DeliveryOrder$}       ? 'DO'
  67              : $type =~ m{::Invoice$}             ? 'AR'
  68              : $type =~ m{::(?:Customer|Vendor)$} ? 'CT'
  69              :                                      croak "Unsupported target class '$type'";
  70
  71   my $new_shipto = SL::DB::Shipto->new(
  72     (map  { +($_ => $self->$_) }
  73      grep { !m{^ (?: itime | mtime | shipto_id | trans_id ) $}x }
  74      map  { $_->name }
  75      @{ $self->meta->columns }),
  76     module           => $module,
  77     custom_variables => [ map { $_->clone_and_reset } @{ $self->custom_variables } ],
  78   );
  79
  80   return $new_shipto;
  81 }
  82
  83 1;
  84
  85 __END__
  86
  87 =pod
  88
  89 =encoding utf8
  90
  91 =head1 NAME
  92
  93 SL::DB::Shipto - Database model for shipping addresses
  94
  95 =head1 SYNOPSIS
  96
  97   my $order = SL::DB::Order->new(id => …)->load;
  98   if ($order->custom_shipto) {
  99     my $cloned_shipto = $order->custom_shipto->clone('SL::DB::Invoice');
 100   }
 101
 102 =head1 FUNCTIONS
 103
 104 =over 4
 105
 106 =item C<is_empty>
 107
 108 Returns truish if all fields to consider are empty, falsish if not.
 109 Fields are trimmed before the test is performed.
 110 C<shiptocp_gender> is not considered because in forms this is usually
 111 a selection with 'm' as default value.
 112 CVar fields are not considered by now.
 113
 114 =back
 115
 116 =over 4
 117
 118 =item C<clone $target>
 119
 120 Creates and returns a clone of the current object. The mandatory
 121 parameter C<$target> must be either an instance of a Rose DB class or
 122 the name of one. It's used for setting the new instance's C<module>
 123 attribute to the correct value.
 124
 125 Currently the following classes are supported:
 126
 127 =over 2
 128
 129 =item C<SL::DB::Order>
 130
 131 =item C<SL::DB::DeliveryOrder>
 132
 133 =item C<SL::DB::Invoice>
 134
 135 =item C<SL::DB::Customer>
 136
 137 =item C<SL::DB::Vendor>
 138
 139 =back
 140
 141 =back
 142
 143 =head1 BUGS
 144
 145 Nothing here yet.
 146
 147 =head1 AUTHOR
 148
 149 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 150
 151 =cut