FS/FS/cust_main/Location.pm

   1 package FS::cust_main::Location;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me @location_fields );
   5 use FS::Record qw(qsearch qsearchs);
   6 use FS::UID qw(dbh);
   7 use FS::cust_location;
   8
   9 use Carp qw(carp);
  10
  11 $DEBUG = 1;
  12 $me = '[FS::cust_main::Location]';
  13
  14 my $init = 0;
  15 BEGIN {
  16   # set up accessors for location fields
  17   if (!$init) {
  18     no strict 'refs';
  19     @location_fields =
  20       qw( address1 address2 city county state zip country district
  21         latitude longitude coord_auto censustract censusyear geocode );
  22
  23     foreach my $f (@location_fields) {
  24       *{"FS::cust_main::Location::$f"} = sub {
  25         carp "WARNING: tried to set cust_main.$f with accessor" if (@_ > 1);
  26         shift->bill_location->$f
  27       };
  28       *{"FS::cust_main::Location::ship_$f"} = sub {
  29         carp "WARNING: tried to set cust_main.ship_$f with accessor" if (@_ > 1);
  30         shift->ship_location->$f
  31       };
  32     }
  33     $init++;
  34   }
  35 }
  36
  37 #debugging shim--probably a performance hit, so remove this at some point
  38 sub get {
  39   my $self = shift;
  40   my $field = shift;
  41   if ( $DEBUG and grep (/^(ship_)?($field)$/, @location_fields) ) {
  42     carp "WARNING: tried to get() location field $field";
  43     $self->$field;
  44   }
  45   $self->FS::Record::get($field);
  46 }
  47
  48 =head1 NAME
  49
  50 FS::cust_main::Location - Location-related methods for cust_main
  51
  52 =head1 DESCRIPTION
  53
  54 These methods are available on FS::cust_main objects;
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item bill_location
  61
  62 Returns an L<FS::cust_location> object for the customer's billing address.
  63
  64 =cut
  65
  66 sub bill_location {
  67   my $self = shift;
  68   $self->hashref->{bill_location}
  69     ||= FS::cust_location->by_key($self->bill_locationnum);
  70 }
  71
  72 =item ship_location
  73
  74 Returns an L<FS::cust_location> object for the customer's service address.
  75
  76 =cut
  77
  78 sub ship_location {
  79   my $self = shift;
  80   $self->hashref->{ship_location}
  81     ||= FS::cust_location->by_key($self->ship_locationnum);
  82 }
  83
  84 =item location TYPE
  85
  86 An alternative way of saying "bill_location or ship_location, depending on
  87 if TYPE is 'bill' or 'ship'".
  88
  89 =cut
  90
  91 sub location {
  92   my $self = shift;
  93   return $self->bill_location if $_[0] eq 'bill';
  94   return $self->ship_location if $_[0] eq 'ship';
  95   die "bad location type '$_[0]'";
  96 }
  97
  98 =back
  99
 100 =head1 CLASS METHODS
 101
 102 =over 4
 103
 104 =item location_fields
 105
 106 Returns a list of fields found in the location objects.  All of these fields
 107 can be read (but not written) by calling them as methods on the
 108 L<FS::cust_main> object (prefixed with 'ship_' for the service address
 109 fields).
 110
 111 =cut
 112
 113 sub location_fields { @location_fields }
 114
 115 sub _upgrade_data {
 116   my $class = shift;
 117   eval "use FS::contact;
 118         use FS::contact_class;
 119         use FS::contact_phone;
 120         use FS::phone_type";
 121
 122   local $FS::cust_location::import = 1;
 123   local $DEBUG = 0;
 124   my $error;
 125
 126   # Step 0: set up contact classes and phone types
 127   my $service_contact_class =
 128     qsearchs('contact_class', { classname => 'Service'})
 129     || new FS::contact_class { classname => 'Service'};
 130
 131   if ( !$service_contact_class->classnum ) {
 132     $error = $service_contact_class->insert;
 133     die "error creating contact class for Service: $error" if $error;
 134   }
 135   my %phone_type = ( # fudge slightly
 136     daytime => 'Work',
 137     night   => 'Home',
 138     mobile  => 'Mobile',
 139     fax     => 'Fax'
 140   );
 141   my $w = 10;
 142   foreach (keys %phone_type) {
 143     $phone_type{$_} = qsearchs('phone_type', { typename => $phone_type{$_}})
 144                       || new FS::phone_type  { typename => $phone_type{$_},
 145                                                weight   => $w };
 146     # just in case someone still doesn't have these
 147     if ( !$phone_type{$_}->phonetypenum ) {
 148       $error = $phone_type{$_}->insert;
 149       die "error creating phone type '$_': $error";
 150     }
 151   }
 152
 153   foreach my $cust_main (qsearch('cust_main', { bill_locationnum => '' })) {
 154     # Step 1: extract billing and service addresses into cust_location
 155     my $custnum = $cust_main->custnum;
 156     my $bill_location = FS::cust_location->new(
 157       {
 158         custnum => $custnum,
 159         map { $_ => $cust_main->get($_) } location_fields()
 160       }
 161     );
 162     $error = $bill_location->insert;
 163     die "error migrating billing address for customer $custnum: $error"
 164       if $error;
 165
 166     $cust_main->set(bill_locationnum => $bill_location->locationnum);
 167
 168     if ( $cust_main->get('ship_address1') ) {
 169       my $ship_location = FS::cust_location->new(
 170         {
 171           custnum => $custnum,
 172           map { $_ => $cust_main->get("ship_$_") } location_fields()
 173         }
 174       );
 175       $error = $ship_location->insert;
 176       die "error migrating service address for customer $custnum: $error"
 177         if $error;
 178
 179       $cust_main->set(ship_locationnum => $ship_location->locationnum);
 180
 181       # Step 2: Extract shipping address contact fields into contact
 182       my %unlike = map { $_ => 1 }
 183         grep { $cust_main->get($_) ne $cust_main->get("ship_$_") }
 184         qw( last first company daytime night fax mobile );
 185
 186       if ( %unlike ) {
 187         # then there IS a service contact
 188         my $contact = FS::contact->new({
 189           'custnum'     => $custnum,
 190           'classnum'    => $service_contact_class->classnum,
 191           'locationnum' => $ship_location->locationnum,
 192           'last'        => $cust_main->get('ship_last'),
 193           'first'       => $cust_main->get('ship_first'),
 194         });
 195         if ( $unlike{'company'} ) {
 196           # there's no contact.company field, but keep a record of it
 197           $contact->set(comment => 'Company: '.$cust_main->get('ship_company'));
 198         }
 199         $error = $contact->insert;
 200         die "error migrating service contact for customer $custnum: $error"
 201           if $error;
 202
 203         foreach ( grep { $unlike{$_} } qw( daytime night fax mobile ) ) {
 204           my $phone = $cust_main->get("ship_$_");
 205           next if !$phone;
 206           my $contact_phone = FS::contact_phone->new({
 207             'contactnum'    => $contact->contactnum,
 208             'phonetypenum'  => $phone_type{$_}->phonetypenum,
 209             FS::contact::_parse_phonestring( $phone )
 210           });
 211           $error = $contact_phone->insert;
 212           # die "whose responsible this"
 213           die "error migrating service contact phone for customer $custnum: $error"
 214             if $error;
 215           $cust_main->set("ship_$_" => '');
 216         }
 217
 218         $cust_main->set("ship_$_" => '') foreach qw(last first company);
 219       } #if %unlike
 220     } #if ship_address1
 221     else {
 222       $cust_main->set(ship_locationnum => $bill_location->locationnum);
 223     }
 224
 225     # Step 3: Wipe the migrated fields and update the cust_main
 226
 227     $cust_main->set("ship_$_" => '') foreach location_fields();
 228     $cust_main->set($_ => '') foreach location_fields();
 229
 230     $error = $cust_main->replace;
 231     die "error migrating addresses for customer $custnum: $error"
 232       if $error;
 233
 234     # Step 4: set packages at the "default service location" to ship_location
 235     foreach my $cust_pkg (
 236       qsearch('cust_pkg', { custnum => $custnum, locationnum => '' })
 237     ) {
 238       # not a location change
 239       $cust_pkg->set('locationnum', $cust_main->ship_locationnum);
 240       $error = $cust_pkg->replace;
 241       die "error migrating package ".$cust_pkg->pkgnum.": $error"
 242         if $error;
 243     }
 244
 245   } #foreach $cust_main
 246 }
 247
 248 =back
 249
 250 =cut
 251
 252 1;