File Coverage

blib/lib/DBIx/Migration/CLI.pm

Criterion	Covered	Total	%
statement	74	74	100.0
branch	23	26	88.4
condition			n/a
subroutine	16	16	100.0
pod	1	1	100.0
total	114	117	97.4

use strict;
use warnings;

#https://stackoverflow.com/questions/24547252/podusage-help-formatting/24812485#24812485

package DBIx::Migration::CLI;

our $VERSION = '0.32';

use DBIx::Migration           ();
use Getopt::Std               qw( getopts );
use Log::Any                  ();
use Log::Any::Adapter         ();
use Module::Load::Conditional qw( can_load );
use PerlX::Maybe              qw( maybe );
use POSIX                     qw( EXIT_FAILURE EXIT_SUCCESS );
use Try::Tiny                 qw( catch try );

sub run {
  local @ARGV = @_;

  my $opts;
  my $exitval;
  {
    local $SIG{ __WARN__ } = sub {
      my $warning = shift;
      chomp $warning;
      $exitval = _usage( -exitval => 2, -message => $warning );
    };
    getopts( '-VT:hp:s:t:u:v', $opts = {} );
  }
  return $exitval if defined $exitval;

  if ( $opts->{ V } ) {
    return _usage( -flavour => 'version' );
  } elsif ( $opts->{ h } ) {
    return _usage( -flavour => 'long' );
  }

  return _usage( -exitval => 2, -message => 'Missing mandatory arguments' ) unless @ARGV;

  my $log_any_adapter_entry;
  $log_any_adapter_entry = Log::Any::Adapter->set( { category => qr/\ADBIx::Migration/ }, 'Stderr' )
    if exists $opts->{ v };
  my $Logger = Log::Any->get_logger( category => 'DBIx::Migration' );
  $exitval = try {
    my $dsn    = shift @ARGV;
    my $driver = DBIx::Migration->driver( $dsn );
    my $class  = "DBIx::Migration::$driver";
    $class = 'DBIx::Migration' unless can_load( modules => { $class => undef } );
    $Logger->infof( "Will use '%s' class to process migrations", $class );
    my $m = $class->new(
      dsn => $dsn,
      maybe
        password => $opts->{ p },
      maybe
        username => $opts->{ u },
      maybe
        managed_schema => $opts->{ s },
      maybe
        tracking_schema => $opts->{ t },
      maybe tracking_table => $opts->{ T }
    );
    if ( @ARGV ) {
      $m->dir( shift @ARGV );

      return ( $m->migrate( @ARGV ? shift @ARGV : () ) ? EXIT_SUCCESS : EXIT_FAILURE );
    } else {
      my $version = $m->version;
      print STDOUT ( defined $version ? $version : '' ), "\n";

      return EXIT_SUCCESS;
    }
  } catch {
    chomp;
    return _usage( -exitval => 2, -message => $_ );
  };
  Log::Any::Adapter->remove( $log_any_adapter_entry ) if defined $log_any_adapter_entry;

  return $exitval;
}

sub _usage {
  my %args;
  {
    use warnings FATAL => qw( misc uninitialized );
    %args = ( -exitval => EXIT_SUCCESS, -flavour => 'short', @_ );
  };

  require Pod::Find;
  require Pod::Usage;

  my %sections = ( long => 'SYNOPSIS|OPTIONS|ARGUMENTS', short => 'SYNOPSIS', version => 'VERSION' );
  Pod::Usage::pod2usage(
    -exitval => 'NOEXIT',
    -indent  => 2,
    -input   => Pod::Find::pod_where( { -inc => 1 }, __PACKAGE__ ),
    exists $args{ -message } ? ( -message => $args{ -message } ) : (),
    -output   => ( $args{ -exitval } == EXIT_SUCCESS ) ? \*STDOUT : \*STDERR,
    -sections => $sections{ $args{ -flavour } },
    -verbose  => 99,
    -width    => 120
  );

  return $args{ -exitval };
}

1;