SL/DB.pm

   1 package SL::DB;
   2
   3 use strict;
   4
   5 use Carp;
   6 use Data::Dumper;
   7 use English qw(-no_match_vars);
   8 use Rose::DB;
   9
  10 use base qw(Rose::DB);
  11
  12 __PACKAGE__->use_private_registry;
  13
  14 my (%_db_registered, %_initial_sql_executed);
  15
  16 sub create {
  17   my $domain = shift || SL::DB->default_domain;
  18   my $type   = shift || SL::DB->default_type;
  19
  20   my ($domain, $type) = _register_db($domain, $type);
  21
  22   my $db = __PACKAGE__->new_or_cached(domain => $domain, type => $type);
  23
  24   return $db;
  25 }
  26
  27 sub _register_db {
  28   my $domain = shift;
  29   my $type   = shift;
  30
  31   my %connect_settings;
  32
  33   if (!%::myconfig) {
  34     $type = 'LXOFFICE_EMPTY';
  35     %connect_settings = ( driver => 'Pg' );
  36
  37   } elsif ($type eq 'LXOFFICE_AUTH') {
  38     %connect_settings = ( driver          => $::myconfig{dbdriver} || 'Pg',
  39                           database        => $::auth->{DB_config}->{db},
  40                           host            => $::auth->{DB_config}->{host},
  41                           port            => $::auth->{DB_config}->{port} || 5432,
  42                           username        => $::auth->{DB_config}->{user},
  43                           password        => $::auth->{DB_config}->{password},
  44                           connect_options => { pg_enable_utf8 => $::locale && $::locale->is_utf8,
  45                                              });
  46   } else {
  47     %connect_settings = ( driver          => $::myconfig{dbdriver} || 'Pg',
  48                           database        => $::myconfig{dbname},
  49                           host            => $::myconfig{dbhost},
  50                           port            => $::myconfig{dbport} || 5432,
  51                           username        => $::myconfig{dbuser},
  52                           password        => $::myconfig{dbpasswd},
  53                           connect_options => { pg_enable_utf8 => $::locale && $::locale->is_utf8,
  54                                              });
  55   }
  56
  57   my %flattened_settings = _flatten_settings(%connect_settings);
  58
  59   $domain = 'LXOFFICE' if $type =~ m/^LXOFFICE/;
  60   $type  .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_}) } sort keys %flattened_settings);
  61   my $idx = "${domain}::${type}";
  62
  63   if (!$_db_registered{$idx}) {
  64     $_db_registered{$idx} = 1;
  65
  66     __PACKAGE__->register_db(domain => $domain,
  67                              type   => $type,
  68                              %connect_settings,
  69                             );
  70   }
  71
  72   return ($domain, $type);
  73 }
  74
  75 sub _flatten_settings {
  76   my %settings  = @_;
  77   my %flattened = ();
  78
  79   while (my ($key, $value) = each %settings) {
  80     if ('HASH' eq ref $value) {
  81       %flattened = ( %flattened, _flatten_settings(%{ $value }) );
  82     } else {
  83       $flattened{$key} = $value;
  84     }
  85   }
  86
  87   return %flattened;
  88 }
  89
  90 1;