Current Path : /proc/self/root/proc/2/root/usr/local/rvglobalsoft/rvglobalsoft/lib/RVL/

Upload File :

Current File : //proc/self/root/proc/2/root/usr/local/rvglobalsoft/rvglobalsoft/lib/RVL/TranslationDB.pm

#!/usr/bin/perl
package RVL::TranslationDB;
##LICENSE##

use strict;
use warnings;
use utf8;
use Data::Dumper;
use DBI;
use Encode qw/encode decode/;
use base qw(Locale::MakePhrase::BackingStore);
use Locale::MakePhrase::Utils qw(die_from_caller);
our $default_host = 'localhost';
our $default_connect_options = {};
our $implicit_table_structure = 'tran_key,tran_language,tran_expression,tran_priority,tran_translation,tran_owner';
our $DEBUG = 0;
use Class::Std::Utils;
{
    sub new {
	my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self = bless {}, $class;

        # get options
        my %options;
        if (@_ > 1 and not(@_ % 2)) {
            %options = @_;
        } elsif (@_ == 1 and ref($_[0]) eq 'HASH') {
          %options = %{$_[0]};
        } elsif (@_ > 0) {
            die_from_caller("Invalid arguments passed to new()");
        }
	$self->{options} = \%options;

        # allow sub-class to control construction
        $self = $self->init();
        return undef unless $self;

        # connect to database
        my $dbh;
        if (exists $options{dbh} or exists $self->{dbh}) {
            # if user passed in a database handle, use it
            # check if we are meant to be the owner of id

            $dbh = (exists $options{dbh}) ? $options{dbh} : $self->{dbh};
            $self->{owned} = (exists $options{owned}) ? ($options{owned} ? 1 : 0) : (exists $self->{owned}) ? ($self->{owned} ? 1 : 0) : 0;

        } else {
            # otherwise, make a specific database handle.. and since we
            # constructed the database handle -> we definately need to destroy it

            $self->{driver} = (exists $options{driver}) ? $options{driver} : $self->{driver};
            $self->{database} = (exists $options{database}) ? $options{database} : $self->{database};
            $self->{host} = (exists $options{host}) ? $options{host} : (exists $self->{host}) ? $self->{host} : undef;
            $self->{port} = (exists $options{port}) ? $options{port} : (exists $self->{port}) ? $self->{port} : undef;
            $self->{user} = (exists $options{user}) ? $options{user} : (exists $self->{user}) ? $self->{user} : undef;
            $self->{password} = (exists $options{password}) ? $options{password} : (exists $self->{password}) ? $self->{password} : undef;
            $self->{connect_options} = (exists $options{connect_options}) ? $options{connect_options} : (exists $self->{connect_options}) ? $self->{connect_options} : $default_connect_options;

            die_from_caller("No 'database driver' specification") unless $self->{driver};
            die_from_caller("No 'database name' specification") unless $self->{database};

            $dbh = $self->_connect();
            $self->{owned} = 1;
        }
	# test database connection and the table structure
        die_from_caller("Database handle is not real?") unless (ref($dbh) and $dbh->can('ping') and $dbh->ping());
        $self->{table} = (exists $options{table}) ? $options{table} : $self->{table};
        die_from_caller("No 'datable table' specification") unless (defined $self->{table} and length $self->{table});
        $self->_test_table_structure($dbh);

        # all is good...
        $self->{dbh} = $dbh;
        return $self;
    }

    sub dbh { shift->{dbh} }

    sub owned {
      my $self = shift;
      if (@_ > 0) {
        my $owned = shift;
        $self->{owned} = $owned ? 1 : 0;
      }
      return $self->{owned};
    }

    sub get_rules {
      my ($self,$context,$key,$languages) = @_;
      my $table = $self->{table};
      my $dbh = $self->{dbh};
      my @translations;

      # ensure connection is good...
      $dbh->ping() or $dbh = $self->_reconnect();
      $dbh->do('SET NAMES utf8');

      # setup query
      my $qry = $self->get_query($table,$context,$languages);
      print STDERR "Using query: $qry\n" if $DEBUG > 4;
      my $sth = $dbh->prepare($qry);
      my $rv = $sth->execute($key);
      return undef unless (defined $rv and $rv > 0);
      my ($k,$language,$expression,$priority,$translation,$owner);
      $sth->bind_columns(\$k,\$language,\$expression,\$priority,\$translation,\$owner);

      # make rules for each result
      while ($sth->fetch()) {
        push @translations, $self->make_rule(
          key => $key,
          language => $language,
          expression => $expression,
          priority => $priority,
          translation => decode("UTF-8", $translation)
        );
      }
      return \@translations;
    }

    sub get_query {
      my ($self,$table,$context,$languages) = @_;
      my $qry = join(' OR ', map("lower(tran_language) = '$_'", @$languages) );
      $qry = sprintf('SELECT %s FROM %s WHERE tran_key = ? AND (%s)',$implicit_table_structure,$table,$qry);
      my $custom = $self->get_where();
      $qry .= " AND $custom" if $custom;
      return $qry;
    }

    sub get_where { 
        my ($self) = @_;
        my $customsql = '';
        if(defined RVL::Session::singleton()->param('aPrefs.owner')){
            my $owner =  RVL::Session::singleton()->param('aPrefs.owner');
            $customsql = sprintf(' (tran_owner = "%s") ;',$owner);
        }else{
            $customsql = sprintf(' (tran_owner = "rvadmin" OR tran_owner = "admin" OR tran_owner = "root");');
        }
        return $customsql;
    }
    
    sub DESTROY {
      my $self = shift;
      if ($self->{owned} && $self->{dbh}) {
        $self->{dbh}->disconnect();
        delete $self->{dbh};
        delete $self->{owned};
      }
    }

    sub _connect {
      my ($self,$options) = @_;
      $options = $self unless $options;

      my $dsn = "dbi:".$options->{driver}.":dbname=". $options->{database} .";";
      $dsn .= "host=". $options->{host} .";" if $options->{host};
      $dsn .= "port=". $options->{port} .";" if $options->{port};
      my $user = $options->{user};
      my $password = $options->{password};
      my $connect_options = $options->{connect_options};

      # try connecting to database
      my $dbh;
      eval { $dbh = DBI->connect($dsn,$user,$password,$connect_options); };
      die_from_caller("Failed to connect to database:\n- dsn: $dsn\n- user: ". (defined $user ? $user : '') ."\n- password: ". (defined $password ? $password : '') ."\n- connect options: ". Dumper($connect_options) ."\nError info:\n$@\n") if ($@);

      if ($self != $options) {
        $self->{driver} = $options->{driver};
        $self->{database} = $options->{database};
        $self->{host} = $options->{host};
        $self->{port} = $options->{port};
        $self->{user} = $options->{user};
        $self->{connect_options} = $options->{connect_options};
        $self->{table} = $options->{table};
      }

      return $dbh;
    }
    sub _test_table_structure {
        my ($self,$dbh) = @_;

        # make sure user specified table exists
        eval {
            my $qry = "SELECT 1 FROM ". $self->{table} ." LIMIT 1";
            my $sth = $dbh->prepare($qry);
            $sth->execute();
        };
        if ($@) {
            $dbh->disconnect() if ($self->{owned} and $dbh);
            die_from_caller("Table '". $self->{table} ."' doesn't exist");
        }

      # make sure user specified table has (at least) the minimum correct structure
      eval {
        my $qry = "SELECT $implicit_table_structure FROM ". $self->{table} ." LIMIT 1";
        print STDERR $qry if $DEBUG > 4;
        my $sth = $dbh->prepare($qry);
        $sth->execute();
      };
      if ($@) {
        $dbh->disconnect() if ($self->{owned} and $dbh);
        die_from_caller("Table '". $self->{table} ."' doesn't exist");
      }

      # make sure user specified table has (at least) the minimum correct structure
      eval {
        my $qry = "SELECT $implicit_table_structure FROM ". $self->{table} ." LIMIT 1";
        print STDERR $qry if $DEBUG > 4;
        my $sth = $dbh->prepare($qry);
        $sth->execute();
      };
      if ($@) {
        $dbh->disconnect() if ($self->{owned} and $dbh);
        die_from_caller("Table ". $self->{table} ." doesn't conform to implicit table structure: $implicit_table_structure");
      }
    }
    
    sub _reconnect {
        my ($self) = @_;
        my $dbh = $self->{dbh};
    
        # Make sure that we own the database handle, and have enough information to reconnect
        die_from_caller("The database connection has failed for some reason... I cannot reconnect as I dont own the database handle...") unless $self->{owned};
        die_from_caller("The database connection has failed for some reason... I cannot reconnect as I dont have any database connection parameters") unless $self->{database};
    
        # cleanup handle
        $dbh->disconnect() if $dbh;
        $self->{dbh} = undef;
    
        # reconnect to database
        $dbh = $self->_connect();
    
        # test database table structure
        $self->_test_table_structure($dbh);
    
        # all is good...
        $self->{dbh} = $dbh;
        return $dbh;
    }
}

1;

Copyright 2K16 - 2K18 Indonesian Hacker Rulez