FS/FS/part_export/acct_sql.pm

   1 package FS::part_export::acct_sql;
   2
   3 use vars qw(@ISA %info @saltset);
   4 use Tie::IxHash;
   5 #use Digest::MD5 qw(md5_hex);
   6 use FS::Record; #qw(qsearchs);
   7 use FS::part_export;
   8
   9 @ISA = qw(FS::part_export);
  10
  11 tie my %options, 'Tie::IxHash',
  12   'datasrc'            => { label => 'DBI data source' },
  13   'username'           => { label => 'Database username' },
  14   'password'           => { label => 'Database password' },
  15 ;
  16
  17 %info = (
  18   'svc'      => 'svc_acct',
  19   'desc'     => 'Real-time export of accounts to SQL databases '.
  20                 '(Postfix+Courier IMAP, others?)',
  21   'options'  => \%options,
  22   'nodomain' => '',
  23   'notes'    => <<END
  24 Export accounts (svc_acct records) to SQL databases.  Written for
  25 Postfix+Courier IMAP but intended to be generally useful for generic SQL
  26 exports eventually.
  27
  28 In contrast to sqlmail, this is newer and less well tested, and currently less
  29 flexible.  It is intended to export just svc_acct records only, rather than a
  30 single export for svc_acct, svc_forward and svc_domain records, and to
  31 be configured for different mail server setups through some subclassing
  32 rather than options.
  33 END
  34 );
  35
  36 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  37
  38 #mapping needs to be configurable...
  39 # export col => freeside col/method or callback
  40 my %map = (
  41   'username' => 'email',
  42   'password' => '_password',
  43   'crypt'    => sub {
  44                   my $svc_acct = shift;
  45                   #false laziness w/shellcommands.pm
  46                   #eventually should check a "password-encoding" field
  47                   if ( length($svc_acct->_password) == 13
  48                        || $svc_acct->_password =~ /^\$(1|2a?)\$/ ) {
  49                     $svc_acct->_password;
  50                   } else {
  51                     crypt(
  52                       $svc_acct->_password,
  53                       $saltset[int(rand(64))].$saltset[int(rand(64))]
  54                     );
  55                   }
  56
  57                 },
  58   'name'     => 'finger',
  59   'maildir'  => sub { $_[0]->domain. '/maildirs/'. $_[0]->username. '/' },
  60   'domain'   => sub { shift->domain },
  61   'svcnum'   => 'svcnum',
  62 );
  63
  64 my $table = 'mailbox'; #also needs to be configurable...
  65
  66 my $primary_key = 'username';
  67
  68 sub rebless { shift; }
  69
  70 sub _export_insert {
  71   my($self, $svc_acct) = (shift, shift);
  72
  73
  74   my %record = map { my $value = $map{$_};
  75                      $_ => ( ref($value)
  76                                ? &{$value}($svc_acct)
  77                                : $svc_acct->$value()
  78                            );
  79                    } keys %map;
  80
  81   my $err_or_queue =
  82     $self->acct_sql_queue( $svc_acct->svcnum, 'insert', $table, %record );
  83   return $err_or_queue unless ref($err_or_queue);
  84
  85   '';
  86
  87 }
  88
  89 sub _export_replace {
  90 }
  91
  92 sub _export_delete {
  93   my ( $self, $svc_acct ) = (shift, shift);
  94   my $keymap = $map{$primary_key};
  95   my $err_or_queue = $self->acct_sql_queue(
  96     $svc_acct->svcnum,
  97     'delete',
  98     $table,
  99     $primary_key => ref($keymap) ? &{$keymap}($svc_acct) : $svc_acct->$keymap()
 100   );
 101   return $err_or_queue unless ref($err_or_queue);
 102   '';
 103 }
 104
 105 sub acct_sql_queue {
 106   my( $self, $svcnum, $method ) = (shift, shift, shift);
 107   my $queue = new FS::queue {
 108     'svcnum' => $svcnum,
 109     'job'    => "FS::part_export::acct_sql::acct_sql_$method",
 110   };
 111   $queue->insert(
 112     $self->option('datasrc'),
 113     $self->option('username'),
 114     $self->option('password'),
 115     @_,
 116   ) or $queue;
 117 }
 118
 119 sub acct_sql_insert { #subroutine, not method
 120   my $dbh = acct_sql_connect(shift, shift, shift);
 121   my( $table, %record ) = @_;
 122
 123   my $sth = $dbh->prepare(
 124     "INSERT INTO $table ( ". join(", ", keys %record).
 125     " ) VALUES ( ". join(", ", map '?', keys %record ). " )"
 126   ) or die $dbh->errstr;
 127
 128   $sth->execute( map $record{$_}, keys %record )
 129     or die "can't insert into $table table: ". $sth->errstr;
 130
 131   $dbh->disconnect;
 132 }
 133
 134 sub acct_sql_delete { #subroutine, not method
 135   my $dbh = acct_sql_connect(shift, shift, shift);
 136   my( $table, %record ) = @_;
 137
 138   my $sth = $dbh->prepare(
 139     "DELETE FROM  $table WHERE ". join(' AND ', map "$_ = ? ", keys %record )
 140   ) or die $dbh->errstr;
 141
 142   $sth->execute( map $record{$_}, keys %record )
 143     or die "can't delete from $table table: ". $sth->errstr;
 144
 145   $dbh->disconnect;
 146 }
 147
 148 sub acct_sql_connect {
 149   #my($datasrc, $username, $password) = @_;
 150   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 151   DBI->connect(@_) or die $DBI::errstr;
 152 }
 153
 154 1;
 155
 156