FS/FS/cust_main/_Marketgear.pm

   1 package FS::cust_main::_Marketgear;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me $conf );
   5
   6 $DEBUG = 0;
   7 $me = '[FS::cust_main::_Marketgear]';
   8
   9 install_callback FS::UID sub {
  10   $conf = new FS::Conf;
  11 };
  12
  13 sub start_copy_skel {
  14   my $self = shift;
  15
  16   return '' unless $conf->config('cust_main-skeleton_tables')
  17                 && $conf->config('cust_main-skeleton_custnum');
  18
  19   warn "  inserting skeleton records\n"
  20     if $DEBUG > 1 || $cust_main::DEBUG > 1;
  21
  22   #'mg_user_preference' => {},
  23   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
  24   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
  25   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
  26   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
  27   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
  28   die $@ if $@;
  29
  30   _copy_skel( 'cust_main',                                 #tablename
  31               $conf->config('cust_main-skeleton_custnum'), #sourceid
  32               $self->custnum,                              #destid
  33               @tables,                                     #child tables
  34             );
  35 }
  36
  37 #recursive subroutine, not a method
  38 sub _copy_skel {
  39   my( $table, $sourceid, $destid, %child_tables ) = @_;
  40
  41   my $primary_key;
  42   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
  43     ( $table, $primary_key ) = ( $1, $2 );
  44   } else {
  45     my $dbdef_table = dbdef->table($table);
  46     $primary_key = $dbdef_table->primary_key
  47       or return "$table has no primary key".
  48                 " (or do you need to run dbdef-create?)";
  49   }
  50
  51   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
  52        join (', ', keys %child_tables). "\n"
  53     if $DEBUG > 2;
  54
  55   foreach my $child_table_def ( keys %child_tables ) {
  56
  57     my $child_table;
  58     my $child_pkey = '';
  59     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
  60       ( $child_table, $child_pkey ) = ( $1, $2 );
  61     } else {
  62       $child_table = $child_table_def;
  63
  64       $child_pkey = dbdef->table($child_table)->primary_key;
  65       #  or return "$table has no primary key".
  66       #            " (or do you need to run dbdef-create?)\n";
  67     }
  68
  69     my $sequence = '';
  70     if ( keys %{ $child_tables{$child_table_def} } ) {
  71
  72       return "$child_table has no primary key".
  73              " (run dbdef-create or try specifying it?)\n"
  74         unless $child_pkey;
  75
  76       #false laziness w/Record::insert and only works on Pg
  77       #refactor the proper last-inserted-id stuff out of Record::insert if this
  78       # ever gets use for anything besides a quick kludge for one customer
  79       my $default = dbdef->table($child_table)->column($child_pkey)->default;
  80       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
  81         or return "can't parse $child_table.$child_pkey default value ".
  82                   " for sequence name: $default";
  83       $sequence = $1;
  84
  85     }
  86
  87     my @sel_columns = grep { $_ ne $primary_key }
  88                            dbdef->table($child_table)->columns;
  89     my $sel_columns = join(', ', @sel_columns );
  90
  91     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
  92     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
  93     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
  94
  95     my $sel_st = "SELECT $sel_columns FROM $child_table".
  96                  " WHERE $primary_key = $sourceid";
  97     warn "    $sel_st\n"
  98       if $DEBUG > 2;
  99     my $sel_sth = dbh->prepare( $sel_st )
 100       or return dbh->errstr;
 101
 102     $sel_sth->execute or return $sel_sth->errstr;
 103
 104     while ( my $row = $sel_sth->fetchrow_hashref ) {
 105
 106       warn "    selected row: ".
 107            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 108         if $DEBUG > 2;
 109
 110       my $statement =
 111         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 112       my $ins_sth =dbh->prepare($statement)
 113           or return dbh->errstr;
 114       my @param = ( $destid, map $row->{$_}, @ins_columns );
 115       warn "    $statement: [ ". join(', ', @param). " ]\n"
 116         if $DEBUG > 2;
 117       $ins_sth->execute( @param )
 118         or return $ins_sth->errstr;
 119
 120       #next unless keys %{ $child_tables{$child_table} };
 121       next unless $sequence;
 122
 123       #another section of that laziness
 124       my $seq_sql = "SELECT currval('$sequence')";
 125       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 126       $seq_sth->execute or return $seq_sth->errstr;
 127       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 128
 129       # don't drink soap!  recurse!  recurse!  okay!
 130       my $error =
 131         _copy_skel( $child_table_def,
 132                     $row->{$child_pkey}, #sourceid
 133                     $insertid, #destid
 134                     %{ $child_tables{$child_table_def} },
 135                   );
 136       return $error if $error;
 137
 138     }
 139
 140   }
 141
 142   return '';
 143
 144 }
 145
 146 1;