view release on metacpan or  search on metacpan

lib/PMLTQ/Command.pm  view on Meta::CPAN

package PMLTQ::Command;
our $AUTHORITY = 'cpan:MATY';
$PMLTQ::Command::VERSION = '2.0.3';
# ABSTRACT: Command base class

use PMLTQ::Base -base;

use utf8;

use DBI;
use File::Slurp;
use Pod::Usage 'pod2usage';

use JSON;
use LWP::UserAgent;
use HTTP::Cookies;
use URI::WithBase;
use URI::Encode qw(uri_encode);
use Encode;

has config => sub { die 'Command has no configuration'; };

has usage => sub {'Usage: '};

has term => sub {
  require Term::UI;
  require Term::ReadLine;
  Term::ReadLine->new('pmltq');
};

has term_encoding => sub {
  require Term::Encoding;
  Term::Encoding::get_encoding();
};


sub run {
  die 'Override by parent class';
}

sub extract_usage {
  my $self = shift;

  open my $handle, '>', \my $output;
  pod2usage( -exitval => 'NOEXIT', -input => (caller)[1], -output => $handle );
  $output =~ s/\n$//;

  return $output;
}

sub help {
  print shift->usage;
}

sub _db_connect {
  my ( $database, $host, $port, $user, $password ) = @_;
  my $dbh = DBI->connect( 'DBI:Pg:dbname=' . $database . ';host=' . $host . ';port=' . $port,
    $user, $password, { RaiseError => 1, PrintError => 1 } )
    or die "Unable to connect to database!\n$DBI::errstr\n";
  return $dbh;
}

sub db {
  my $self = shift;

  my $db = $self->config->{db};
  return _db_connect( $db->{name}, $db->{host}, $db->{port}, $db->{user}, $db->{password} );
}

sub sys_db {
  my $self = shift;

  my $config = $self->config;
  my $db     = $config->{db};
  my $sys_db = $config->{sys_db};

  unless ( ref $sys_db ) {
    $sys_db = { name => $sys_db };
  }

  $sys_db->{$_} = $db->{$_} for ( grep { !defined $sys_db->{$_} } qw/user password/ );

  return _db_connect( $sys_db->{name}, $db->{host}, $db->{port}, $sys_db->{user}, $sys_db->{password} );
}

sub run_sql_from_file {
  my ( $self, $file, $dir, $dbh ) = @_;

  my $sqlfile = File::Spec->catfile( $dir, $file );
  my $sql = read_file($sqlfile);

  print STDERR "RUNNING SQL FROM $sqlfile\n";
  if ( $file =~ m/.ctl/ and my $copy = () = $sql =~ m/(COPY .*? FROM *?["'].*?["'])/g ) {
    die "More COPY commands than one in file is not supported.\n\n$sql\n" if $copy > 1;
    $sql =~ s/(COPY .*? FROM) *?["'](.*?)["']/$1 STDIN/;
    my $dump_file = File::Spec->catfile( $dir, $2 );
    eval {
      $dbh->do($sql);
      open my $fh, '<', "$dump_file" or die "Can't open $dump_file: $!";
      while ( my $data = <$fh> ) {    # Do not load whole file, but process it line by line
        next unless $data;
        $data= Encode::decode("UTF-8", $data, Encode::FB_CROAK);
        $dbh->pg_putcopydata("$data");
      }
      $dbh->pg_putcopyend();