FS/FS/part_export/sql_Common.pm

   1 package FS::part_export::sql_Common;
   2 use base qw( FS::part_export );
   3
   4 use strict;
   5 use Tie::IxHash;
   6
   7 tie my %options, 'Tie::IxHash',
   8   'datasrc'            => { label => 'DBI data source' },
   9   'username'           => { label => 'Database username' },
  10   'password'           => { label => 'Database password' },
  11   'table'              => { label => 'Database table' },
  12   'schema'             => { label =>
  13                               'Database schema mapping to Freeside methods.',
  14                             type  => 'textarea',
  15                           },
  16   'static'             => { label =>
  17                               'Database schema mapping to static values.',
  18                             type  => 'textarea',
  19                           },
  20   'primary_key'        => { label => 'Database primary key' },
  21 ;
  22
  23 sub sql_options {
  24   \%options;
  25 }
  26 sub _schema_map { shift->_map('schema'); }
  27 sub _static_map { shift->_map('static'); }
  28
  29 sub _map {
  30   my $self = shift;
  31   map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option(shift) );
  32 }
  33
  34 sub _map_arg_callback {
  35   ();
  36 }
  37
  38 sub rebless { shift; }
  39
  40 sub _export_insert {
  41   my($self, $svc_x) = (shift, shift);
  42
  43   my %schema = $self->_schema_map;
  44   my %static = $self->_static_map;
  45
  46   my %record = (
  47
  48     ( map { $_ => $static{$_} } keys %static ),
  49
  50     ( map { my $value = $schema{$_};
  51             my @arg = $self->_map_arg_callback($value);
  52             $_ => $svc_x->$value(@arg);
  53           } keys %schema
  54     ),
  55
  56   );
  57
  58   my $err_or_queue =
  59     $self->sql_Common_queue(
  60       $svc_x->svcnum,
  61       'insert',
  62       $self->option('table'),
  63       %record
  64     );
  65   return $err_or_queue unless ref($err_or_queue);
  66
  67   '';
  68
  69 }
  70
  71 sub _export_replace {
  72   my($self, $new, $old) = (shift, shift, shift);
  73
  74   my %schema = $self->_schema_map;
  75   my %static = $self->_static_map;
  76
  77   my @primary_key = ();
  78   if ( $self->option('primary_key') =~ /,/ ) {
  79     foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) {
  80       my $keymap = $schema{$key};
  81       push @primary_key, $old->$keymap();
  82     }
  83   } else {
  84     my $keymap = $schema{$self->option('primary_key')};
  85     push @primary_key, $old->$keymap();
  86   }
  87
  88   my %record = (
  89
  90     ( map { $_ => $static{$_} } keys %static ),
  91
  92     ( map { my $value = $schema{$_};
  93             my @arg = $self->_map_arg_callback($value);
  94             $_ => $new->$value(@arg);
  95           } keys %schema
  96     ),
  97
  98   );
  99
 100   my $err_or_queue = $self->sql_Common_queue(
 101     $new->svcnum,
 102     'replace',
 103     $self->option('table'),
 104     $self->option('primary_key'), @primary_key,
 105     %record,
 106   );
 107   return $err_or_queue unless ref($err_or_queue);
 108   '';
 109 }
 110
 111 sub _export_delete {
 112   my ( $self, $svc_x ) = (shift, shift);
 113
 114   my %schema = $self->_schema_map;
 115
 116   my %primary_key = ();
 117   if ( $self->option('primary_key') =~ /,/ ) {
 118     foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) {
 119       my $keymap = $schema{$key};
 120       $primary_key{ $key } = $svc_x->$keymap();
 121     }
 122   } else {
 123     my $keymap = $schema{$self->option('primary_key')};
 124     $primary_key{ $self->option('primary_key') } = $svc_x->$keymap(),
 125   }
 126
 127   my $err_or_queue = $self->sql_Common_queue(
 128     $svc_x->svcnum,
 129     'delete',
 130     $self->option('table'),
 131     %primary_key,
 132     #$self->option('primary_key') => $svc_x->$keymap(),
 133   );
 134   return $err_or_queue unless ref($err_or_queue);
 135   '';
 136 }
 137
 138 sub sql_Common_queue {
 139   my( $self, $svcnum, $method ) = (shift, shift, shift);
 140   my $queue = new FS::queue {
 141     'svcnum' => $svcnum,
 142     'job'    => "FS::part_export::sql_Common::sql_Common_$method",
 143   };
 144   $queue->insert(
 145     $self->option('datasrc'),
 146     $self->option('username'),
 147     $self->option('password'),
 148     @_,
 149   ) or $queue;
 150 }
 151
 152 sub sql_Common_insert { #subroutine, not method
 153   my $dbh = sql_Common_connect(shift, shift, shift);
 154   my( $table, %record ) = @_;
 155
 156   my $sth = $dbh->prepare(
 157     "INSERT INTO $table ( ". join(", ", keys %record).
 158     " ) VALUES ( ". join(", ", map '?', keys %record ). " )"
 159   ) or die $dbh->errstr;
 160
 161   $sth->execute( values(%record) )
 162     or die "can't insert into $table table: ". $sth->errstr;
 163
 164   $dbh->disconnect;
 165 }
 166
 167 sub sql_Common_delete { #subroutine, not method
 168   my $dbh = sql_Common_connect(shift, shift, shift);
 169   my( $table, %record ) = @_;
 170
 171   my $sth = $dbh->prepare(
 172     "DELETE FROM $table WHERE ". join(' AND ', map "$_ = ? ", keys %record )
 173   ) or die $dbh->errstr;
 174
 175   $sth->execute( map $record{$_}, keys %record )
 176     or die "can't delete from $table table: ". $sth->errstr;
 177
 178   $dbh->disconnect;
 179 }
 180
 181 sub sql_Common_replace { #subroutine, not method
 182   my $dbh = sql_Common_connect(shift, shift, shift);
 183
 184   my( $table, $pkey ) = ( shift, shift );
 185
 186   my %primary_key = ();
 187   if ( $pkey =~ /,/ ) {
 188     foreach my $key ( split(/\s*,\s*/, $pkey ) ) {
 189       $primary_key{$key} = shift;
 190     }
 191   } else {
 192     $primary_key{$pkey} = shift;
 193   }
 194
 195   my %record = @_;
 196
 197   my $sth = $dbh->prepare(
 198     "UPDATE $table".
 199     ' SET '.   join(', ',    map "$_ = ?", keys %record      ).
 200     ' WHERE '. join(' AND ', map "$_ = ?", keys %primary_key )
 201   ) or die $dbh->errstr;
 202
 203   $sth->execute( values(%record), values(%primary_key) );
 204
 205   $dbh->disconnect;
 206 }
 207
 208 sub sql_Common_connect {
 209   #my($datasrc, $username, $password) = @_;
 210   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 211   DBI->connect(@_) or die $DBI::errstr;
 212 }
 213
 214 1;
 215