view release on metacpan or  search on metacpan

lib/App/Sqitch.pm  view on Meta::CPAN

# ABSTRACT: Sensible database change management

use 5.010;
use strict;
use warnings;
use utf8;
use Getopt::Long;
use Hash::Merge qw(merge);
use Path::Class;
use Config;
use Locale::TextDomain 1.20 qw(App-Sqitch);
use Locale::Messages qw(bind_textdomain_filter);
use App::Sqitch::X qw(hurl);
use Moo 1.002000;
use Type::Utils qw(where declare);
use App::Sqitch::Types qw(Str UserName UserEmail Maybe Config HashRef);
use Encode ();
use Try::Tiny;
use List::Util qw(first);
use IPC::System::Simple 1.17 qw(runx capturex $EXITVAL);
use namespace::autoclean 0.16;
use constant ISWIN => $^O eq 'MSWin32';

our $VERSION = 'v1.6.1'; # VERSION

BEGIN {
    # Force Locale::TextDomain to encode in UTF-8 and to decode all messages.
    $ENV{OUTPUT_CHARSET} = 'UTF-8';
    bind_textdomain_filter 'App-Sqitch' => \&Encode::decode_utf8, Encode::FB_DEFAULT;
}

# Okay to load Sqitch classes now that types are created.
use App::Sqitch::Config;
use App::Sqitch::Command;
use App::Sqitch::Plan;

has options => (
    is      => 'ro',
    isa     => HashRef,
    default => sub { {} },
);

has verbosity => (
    is       => 'ro',
    lazy     => 1,
    default  => sub {
        my $self = shift;
        $self->options->{verbosity} // $self->config->get( key => 'core.verbosity' ) // 1;
    }
);

has sysuser => (
    is       => 'ro',
    isa      => Maybe[Str],
    lazy     => 1,
    default  => sub {
        $ENV{ SQITCH_ORIG_SYSUSER } || do {
            # Adapted from User.pm.
            require Encode::Locale;
            return Encode::decode( locale => getlogin )
                || Encode::decode( locale => scalar getpwuid( $< ) )
                || $ENV{ LOGNAME }
                || $ENV{ USER }
                || $ENV{ USERNAME }
                || try {
                    require Win32;
                    Encode::decode( locale => Win32::LoginName() )
                };
        };
    },
);

has user_name => (
    is      => 'ro',
    lazy    => 1,
    isa     => UserName,
    default => sub {
        my $self = shift;
        $ENV{ SQITCH_FULLNAME }
            || $self->config->get( key => 'user.name' )
            || $ENV{ SQITCH_ORIG_FULLNAME }
        || do {
            my $sysname = $self->sysuser || hurl user => __(
                'Cannot find your name; run sqitch config --user user.name "YOUR NAME"'
            );
            if (ISWIN) {
                try { require Win32API::Net } || return $sysname;
                # https://stackoverflow.com/q/12081246/79202
                Win32API::Net::UserGetInfo( $ENV{LOGONSERVER}, $sysname, 10, my $info = {} );
                return $sysname unless $info->{fullName};
                require Encode::Locale;
                return Encode::decode( locale => $info->{fullName} );
            }
            require User::pwent;
            my $name = User::pwent::getpwnam($sysname) || return $sysname;
            $name = ($name->gecos)[0] || return $sysname;
            require Encode::Locale;
            return Encode::decode( locale => $name );
        };
    }
);

has user_email => (
    is      => 'ro',
    lazy    => 1,
    isa     => UserEmail,
    default => sub {
        my $self = shift;
         $ENV{ SQITCH_EMAIL }
            || $self->config->get( key => 'user.email' )
            || $ENV{ SQITCH_ORIG_EMAIL }
        || do {
            my $sysname = $self->sysuser || hurl user => __x(
                'Cannot infer your email address; run sqitch config --user user.email {email}',
                email => 'you@example.com',
            );
            require Sys::Hostname;
            "$sysname@" . Sys::Hostname::hostname();
        };
    }
);