FS/FS/part_export/sqlmail.pm

   1 package FS::part_export::sqlmail;
   2
   3 use vars qw(@ISA);
   4 use FS::Record qw(qsearchs);
   5 use FS::part_export;
   6 use Digest::MD5 qw(md5_hex);
   7
   8 @ISA = qw(FS::part_export);
   9
  10 sub rebless { shift; }
  11
  12 sub _export_insert {
  13   my($self, $svc) = (shift, shift);
  14   # this is a svc_something.
  15
  16   my $svcdb = $svc->cust_svc->part_svc->svcdb;
  17   my $export_table = $self->option($svcdb . '_table')
  18     or die('Export table not defined for svcdb: ' . $svcdb);
  19   my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
  20   my $svchash = update_values($self, $svc, $svcdb);
  21
  22   foreach my $key (keys(%$svchash)) {
  23     unless (grep { $key eq $_ } @export_fields) {
  24       delete $svchash->{$key};
  25     }
  26   }
  27
  28   my $error = $self->sqlmail_queue( $svc->svcnum, 'insert',
  29     $self->option('server_type'), $export_table,
  30     (map { ($_, $svchash->{$_}); } keys(%$svchash)));
  31   return $error if $error;
  32   '';
  33
  34 }
  35
  36 sub _export_replace {
  37   my( $self, $new, $old ) = (shift, shift, shift);
  38
  39   my $svcdb = $new->cust_svc->part_svc->svcdb;
  40   my $export_table = $self->option($svcdb . '_table')
  41     or die('Export table not defined for svcdb: ' . $svcdb);
  42   my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
  43   my $svchash = update_values($self, $new, $svcdb);
  44
  45   foreach my $key (keys(%$svchash)) {
  46     unless (grep { $key eq $_ } @export_fields) {
  47       delete $svchash->{$key};
  48     }
  49   }
  50
  51   my $error = $self->sqlmail_queue( $new->svcnum, 'replace',
  52     $old->svcnum, $self->option('server_type'), $export_table,
  53     (map { ($_, $svchash->{$_}); } keys(%$svchash)));
  54   return $error if $error;
  55   '';
  56
  57 }
  58
  59 sub _export_delete {
  60   my( $self, $svc ) = (shift, shift);
  61
  62   my $svcdb = $svc->cust_svc->part_svc->svcdb;
  63   my $table = $self->option($svcdb . '_table')
  64     or die('Export table not defined for svcdb: ' . $svcdb);
  65
  66   $self->sqlmail_queue( $svc->svcnum, 'delete', $table,
  67     $svc->svcnum );
  68 }
  69
  70 sub sqlmail_queue {
  71   my( $self, $svcnum, $method ) = (shift, shift, shift);
  72   my $queue = new FS::queue {
  73     'svcnum' => $svcnum,
  74     'job'    => "FS::part_export::sqlmail::sqlmail_$method",
  75   };
  76   $queue->insert(
  77     $self->option('datasrc'),
  78     $self->option('username'),
  79     $self->option('password'),
  80     @_,
  81   );
  82 }
  83
  84 sub sqlmail_insert { #subroutine, not method
  85   my $dbh = sqlmail_connect(shift, shift, shift);
  86   my( $server_type, $table ) = (shift, shift);
  87
  88   my %attrs = @_;
  89
  90   map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
  91   my $query = sprintf("INSERT INTO %s (%s) values (%s)",
  92                       $table, join(",", keys(%attrs)),
  93                       join(',', values(%attrs)));
  94
  95   $dbh->do($query) or die $dbh->errstr;
  96   $dbh->disconnect;
  97
  98   '';
  99 }
 100
 101 sub sqlmail_delete { #subroutine, not method
 102   my $dbh = sqlmail_connect(shift, shift, shift);
 103   my( $table, $svcnum ) = @_;
 104
 105   $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr;
 106   $dbh->disconnect;
 107
 108   '';
 109 }
 110
 111 sub sqlmail_replace {
 112   my $dbh = sqlmail_connect(shift, shift, shift);
 113   my($oldsvcnum, $server_type, $table) = (shift, shift, shift);
 114
 115   my %attrs = @_;
 116   map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
 117
 118   my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum";
 119   my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr;
 120
 121   if (@$result[0] == 0) {
 122     $query = sprintf("INSERT INTO %s (%s) values (%s)",
 123                      $table, join(",", keys(%attrs)),
 124                      join(',', values(%attrs)));
 125     $dbh->do($query) or die $dbh->errstr;
 126   } else {
 127     $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s',
 128                      $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)),
 129                      $oldsvcnum);
 130     $dbh->do($query) or die $dbh->errstr;
 131   }
 132
 133   $dbh->disconnect;
 134
 135   '';
 136 }
 137
 138 sub sqlmail_connect {
 139   DBI->connect(@_) or die $DBI::errstr;
 140 }
 141
 142 sub update_values {
 143
 144   # Update records to conform to a particular server_type.
 145
 146   my ($self, $svc, $svcdb) = (shift,shift,shift);
 147   my $svchash = { %{$svc->hashref} } or return ''; # We need a copy.
 148
 149   if ($svcdb eq 'svc_acct') {
 150     if ($self->option('server_type') eq 'courier_crypt') {
 151       my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
 152       $svchash->{_password} = crypt($svchash->{_password}, $salt);
 153
 154     } elsif ($self->option('server_type') eq 'dovecot_plain') {
 155       $svchash->{_password} = '{PLAIN}' . $svchash->{_password};
 156
 157     } elsif ($self->option('server_type') eq 'dovecot_crypt') {
 158       my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
 159       $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt);
 160
 161     } elsif ($self->option('server_type') eq 'dovecot_digest_md5') {
 162       my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc });
 163       die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc)
 164         unless ($svc_domain);
 165
 166       my $domain = $svc_domain->domain;
 167       my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username},
 168                                              $domain, $svchash->{_password}));
 169       $svchash->{_password} = $md5hash;
 170     }
 171   } elsif ($svcdb eq 'svc_forward') {
 172     if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) {
 173       $svchash->{dst} = $svc->dstsvc_acct->username . '@' .
 174                         $svc->dstsvc_acct->svc_domain->domain;
 175     }
 176   }
 177
 178   return($svchash);
 179
 180 }
 181