Acrux

 view release on metacpan or  search on metacpan

lib/Acme/Crux.pm  view on Meta::CPAN

    }, $class;

    # Modes
    foreach my $mode ( @{(ALOWED_MODES)}) {
        $self->{$mode."mode"} = 1 if is_true_flag($args->{$mode});
    }

    # Root dir
    my $root = $self->{root};
    $root = $self->{root} = $pwd if defined($root) && $root eq '.';
    unless (defined($root) && length($root)) {
        $root = $self->{root} = File::Spec->catdir(SYSCONFDIR, $moniker);
    }

    # Temp dir
    my $temp = $self->{tempdir};
    unless (defined($temp) && length($temp)) {
        $temp = $self->{tempdir} = File::Spec->catdir(File::Spec->tmpdir(), $moniker);
    }

    # Data dir
    my $datadir = $self->{datadir};
    unless (defined($datadir) && length($datadir)) {
        $datadir = $self->{datadir} = File::Spec->catdir(SHAREDSTATEDIR, $moniker);
    }

    # Log dir
    my $logdir = $self->{logdir};
    unless (defined($logdir) && length($logdir)) {
        $logdir = $self->{logdir} = File::Spec->catdir(LOGDIR, $moniker);
    }

    # Share dir
    my $sharedir = $self->{sharedir};
    unless (defined($sharedir) && length($sharedir)) {
        $self->{sharedir} = File::Spec->catdir(DATADIR, $moniker);
    }

    # Doc dir
    my $docdir = $self->{docdir};
    unless (defined($docdir) && length($docdir)) {
        $self->{docdir} = File::Spec->catdir(DOCDIR, $moniker);
    }

    # Cache dir
    my $cachedir = $self->{cachedir};
    unless (defined($cachedir) && length($cachedir)) {
        $self->{cachedir} = File::Spec->catdir(CACHEDIR, $moniker);
    }

    # Spool dir
    my $spooldir = $self->{spooldir};
    unless (defined($spooldir) && length($spooldir)) {
        $self->{spooldir} = File::Spec->catdir(SPOOLDIR, $moniker);
    }

    # Run dir
    my $rundir = $self->{rundir};
    unless (defined($rundir) && length($rundir)) {
        $rundir = $self->{rundir} = File::Spec->catdir(RUNDIR, $moniker);
    }

    # Lock dir
    my $lockdir = $self->{lockdir};
    unless (defined($lockdir) && length($lockdir)) {
        $self->{lockdir} = File::Spec->catdir(LOCKDIR, $moniker);
    }

    # Web dir
    my $webdir = $self->{webdir};
    unless (defined($webdir) && length($webdir)) {
        $self->{webdir} = File::Spec->catdir(WEBDIR, $moniker);
    }

    # Config file
    my $configfile = $self->{configfile};
    unless (defined($configfile) && length($configfile)) {
        $self->{configfile} = File::Spec->catfile(IS_ROOT ? $root : $pwd, sprintf("%s.conf", $moniker));
    }

    # Log file
    my $logfile = $self->{logfile};
    unless (defined($logfile) && length($logfile)) {
        $self->{logfile} = File::Spec->catfile(IS_ROOT ? $logdir : $pwd, sprintf("%s.log", $moniker));
    }

    # PID file
    my $pidfile = $self->{pidfile};
    unless (defined($pidfile) && length($pidfile)) {
        $self->{pidfile} = File::Spec->catfile(IS_ROOT ? $rundir : $pwd, sprintf("%s.pid", $moniker));
    }

    # Define plugins list to plugin map
    $self->plugins(as_hash_ref($args->{plugins}));

    # Preloading plugins
    my $preload_plugins = $self->{preload_plugins};
       $preload_plugins = [$preload_plugins] unless is_array_ref($preload_plugins);
    my $pplgns = words(@$preload_plugins);

lib/Acme/Crux.pm  view on Meta::CPAN

}

# Plugins
sub plugins {
    my $self = shift;
    return $self->{plugins} if scalar(@_) < 1;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $plugins = $self->{plugins};
    foreach my $k (keys %$args) {
        next if exists($plugins->{$k}) && $plugins->{$k}->{loaded}; # Skip loaded plugins
        $plugins->{$k} = { class => $args->{$k}, loaded => 0 } if length($args->{$k} // '');
    }
    return $self;
}
sub plugin {
    my $self = shift;
    my $name = shift // ''; # Plugin name
    my $class = shift // ''; # Plugin class
    my @args = @_;
    my $plugins = $self->{plugins}; # Get list of plugins
    return unless length $name;

    # Lookup class by name
    unless (length($class)) {
        # Lookup in existing plugins
        $class = $plugins->{$name}->{class} // '' if exists $plugins->{$name};

        # Lookup in defaults
        $class = DEFAULT_PLUGINS()->{$name} // '' unless length $class;
    }
    return unless length $class;

    # Register found plugin
    $self->register_plugin($name, $class, @args); # name, class, args
}
sub register_plugin {
    my $self = shift;
    my $name = shift // ''; # Plugin name
    my $class = shift // ''; # Plugin class
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}; # Plugin arguments
    my $plugins = $self->{plugins};
    croak "No plugin name specified!" unless length $name;
    croak "No plugin class specified!" unless length $class;

    # Load plugin if not exists in already loaded plugins list
    return 1 if exists($plugins->{$name}) && $plugins->{$name}->{loaded};
    if (my $error = load_class($class)) {
        $self->verbosemode
            ? die qq{Plugin "$name" missing, maybe you need to install it?\n$error\n}
            : die qq{Plugin "$name" missing, maybe you need to install it?\n};
    }

    # Create plugin instance

lib/Acme/Crux.pm  view on Meta::CPAN

sub register_handler {
    my $class = shift;
       $class = ref($class) if ref($class);
    my %info = @_;
    my $k = "$class.$$";
    $Acme::Crux::Sandbox::HANDLERS{$k} = {} unless exists($Acme::Crux::Sandbox::HANDLERS{$k});
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{$k};

    # Handler name
    my $name = trim($info{handler} // $info{name} // 'default');
    croak("The handler name missing") unless length($name);
    delete $info{handler};
    $info{name} = $name;
    croak("The $name duplicate handler definition") if defined($handlers->{$name});

    # Handler aliases
    my $_aliases = $info{alias} // $info{aliases} // [];
       $_aliases = [ trim($_aliases) ] unless is_array_ref($_aliases);
    my $aliases = words(@$_aliases);
    #foreach my $al (@$_aliases) {
    #    next unless defined($al) && is_value($al);
    #    foreach my $p (split(/[\s;,]+/, $al)) {
    #        next unless defined($p) && length($p);
    #        $aliases{$p} = 1;
    #    }
    #}
    delete $info{alias};
    $info{aliases} = [grep {$_ ne $name} @$aliases];

    # Handler description
    $info{description} //= '';

    # Handler params

lib/Acme/Crux.pm  view on Meta::CPAN

    my $code = $info{code} || sub {return 1};
    $info{code} = is_code_ref($code) ? $code : sub { $code };

    # Set info to handler data
    $handlers->{$name} = {%info};
    return 1;
}
sub lookup_handler {
    my $self = shift;
    my $name = trim(shift // '');
    return undef unless length $name;
    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return undef unless defined($handlers) && is_hash_ref($handlers);
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        return $handlers->{$n} if grep {defined && $_ eq $name} ($n, @$aliases);
    }
    return undef;
}
sub handlers {

lib/Acme/Crux.pm  view on Meta::CPAN

    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return [] unless defined($handlers) && is_hash_ref($handlers);
    return [(sort {$a cmp $b} keys %$handlers)] unless $all;

    # All: names and aliases
    my %seen = ();
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        foreach my $_a ($n, @$aliases) {
            $seen{$_a} = 1 if defined($_a) and length($_a);
        }
    }
    return [(sort {$a cmp $b} keys %seen)];
}
sub run_handler {
    my $self = shift;
    my $name = shift // 'default';
    my @args = @_;
    if ($self->{running}) {
        $self->error(sprintf(qq{The application "%s" is already runned}, $self->project));
        return 0;
    }
    unless(length($name)) {
        $self->error("Invalid handler name");
        return 0;
    }
    my $meta = $self->lookup_handler($name);
    unless ($meta) {
        $self->error(sprintf("Handler %s not found", $name));
        return 0;
    }

    # Run

lib/Acme/Crux.pm  view on Meta::CPAN

}
sub run { goto &run_handler }

# Internal functions (NOT METHODS)
sub _project2moniker {
    my $prj = shift;
    return unless defined($prj);
    $prj =~ s/::/-/g;
    $prj =~ s/[^A-Za-z0-9_\-.]/_/g; # Remove incorrect chars
    $prj =~ s/([_\-.]){2,}/$1/g; # Remove dubles
    return unless length($prj);
    return lc($prj);
}

1;

package Acme::Crux::Sandbox;

our %HANDLERS = ();

1;

lib/Acme/Crux/Plugin/Log.pm  view on Meta::CPAN

      || ($has_config ? $app->config->get("/logfacility") : ''); # From config file

    # Log file: PLGARGS || OPTS || CONF || ORIG || DEFS
    my $file = $args->{file}  # From plugin arguments first
      || $app->getopt("logfile") # From command line options
      || ($has_config ? $app->config->get("/logfile") : '') # From config file
      || $app->logfile; # From App arguments

    # Format: PLGARGS || DEFS
    my $frmt = $args->{format} || $app->orig->{"logformat"};
    if (defined($frmt) && length($frmt)) {
        croak(qq{Invalid log format coderef}) unless is_code_ref($frmt);
    }

    # Handle: PLGARGS || DEFS
    my $handle = $args->{handle} || $app->orig->{"loghandle"};
    if (defined $handle) {
        croak(qq{Invalid log handle}) unless is_ref($handle);
    }

    # Log ident: PLGARGS || OPTS || ORIG || CONF || DEFS

lib/Acrux/Config.pm  view on Meta::CPAN

            root    => $args->{root} // '', # base path to default files/directories
            dirs    => $args->{dirs} || [],
            noload  => $args->{noload} || 0,
            options => {},
            error   => '',
            config  => {},
            pointer => Acrux::Pointer->new,
            files   => [],
            orig    => $args->{options} || $args->{opts} || {},
        }, $class;
    my $myroot = length($self->{root}) ? $self->{root} : getcwd();

    # Set dirs
    my @dirs = ();
    foreach my $dir (as_array($self->{dirs})) {
        unless (File::Spec->file_name_is_absolute($dir)) { # rel
            $dir = length($myroot)
                ? File::Spec->rel2abs($dir, $myroot)
                : File::Spec->rel2abs($dir);
        }
        push @dirs, $dir if -e $dir;
    }
    $self->{dirs} = [@dirs];

    # Set config file
    my $file = $self->{file};
       $file = sprintf("%s.conf", basename($0)) unless length $file;
    unless (File::Spec->file_name_is_absolute($file)) { # rel
        $file = length($myroot)
                ? File::Spec->rel2abs($file, $myroot)
                : File::Spec->rel2abs($file);
    }
    $self->{file} = $file;
    unless ($self->{noload}) {
        unless (-r $file) {
            $self->{error} = sprintf("Configuration file \"%s\" not found or unreadable", $file);
            return $self;
        }
    }

lib/Acrux/Config.pm  view on Meta::CPAN

    # Set config data
    $self->{config} = {%config}; # hash data
    $self->pointer->data(clone($self->{config}));

    return $self;
}
sub config {
    my $self = shift;
    my $key  = shift;
    return undef unless $self->{config};
    return $self->{config} unless defined $key and length $key;
    return $self->{config}->{$key};
}
sub conf { goto &config }
sub get {
    my $self = shift;
    my $key = shift;
    return $self->pointer->get($key);
}
sub first {
    my $self = shift;
    return undef unless defined($_[0]) && length($_[0]);
    my $node = $self->pointer->get($_[0]);
    if (is_array_ref($node)) { # Array ref
        return exists($node->[0]) ? $node->[0] : undef;
    } elsif (is_value($node)) { # Scalar value
        return $node;
    }
    return undef;
}
sub latest {
    my $self = shift;
    return undef unless defined($_[0]) && length($_[0]);
    my $node = $self->pointer->get($_[0]);
    if (is_array_ref($node)) { # Array ref
        return exists($node->[0]) ? $node->[-1] : undef;
    } elsif (is_value($node)) { # Scalar value
        return $node;
    }
    return undef;
}
sub array {
    my $self = shift;
    return undef unless defined($_[0]) && length($_[0]);
    my $node = $self->pointer->get($_[0]);
    if (is_array_ref($node)) { # Array ref
        return $node;
    } elsif (defined($node)) {
        return [$node];
    }
    return [];
}
sub list { goto &array }
sub hash {
    my $self = shift;
    return undef unless defined($_[0]) && length($_[0]);
    my $node = $self->pointer->get($_[0]);
    return $node if is_hash_ref($node);
    return {};
}
sub object { goto &hash }

1;

__END__

lib/Acrux/Digest/M11R.pm  view on Meta::CPAN


use parent qw/Acrux::Digest/;

sub digest {
    # See also: Algorithm::CheckDigits::M11_015 and check_okpo()
    my $self = shift;
    my $data = shift;
       $self->data($data) if defined $data;
    my $test = $self->data;
    croak "Incorrect input digit-string" if !defined($test) || $test =~ m/[^0-9]/g;
    my $len = length($test);
    my $iters = ($len + (($len & 1) ? 1 : 0)) / 2;
    my @digits = split(//, $test); # Get all digits from input string of chars
    #printf "Test=%s; len=%d; iters=%d\n", $test, $len, $iters;

    my $w_lim = 10; # Maximum for round-robin(10) weight list: 1,2,3,4,5,6,7,8,9,10,1,2,3,4,5...
    my $step = 2; # Step for weight list offset calculation for next iteration

    # Calculation sum for one weight list by ofset
    my $calc = sub {
        my $off = shift || 0;

lib/Acrux/Log.pm  view on Meta::CPAN

            return $logger->$code(@msg);
        } else {
            carp(sprintf("Can't found '%s' method in '%s' package", $name, ref($logger)));
        }
        return 0;
    }

    # Handle
    if (my $handle = $self->handle) {
        # Set message
        my $pfx = (defined($self->{prefix}) && length($self->{prefix})) ? $self->{prefix} : '';
        my $_msg = $ENCODING->encode($pfx . $self->{format}->(time, $level, @msg), 0);

        # Flush
        if ($self->{provider} eq "file") { # Flush to file
            flock $handle, LOCK_EX;
            $handle->print($_msg) or croak "Can't write to log file: $!";
            flock $handle, LOCK_UN;
        } elsif ($self->{provider} eq "handle") { # Flush to handle
            print $handle $_msg;
        } else {

lib/Acrux/Pointer.pm  view on Meta::CPAN

}
sub contains { shift->_p(0, @_) }
sub get      { shift->_p(1, @_) }

sub _p {
    my $self = shift;
    my $get = shift;
    my $pointer = shift // '';
       $pointer =~ s|^/||;
    my $data = $self->data;
    return $get ? $data : 1 unless length($pointer);
    foreach my $p (length($pointer) ? (split /\//, $pointer, -1) : ($pointer)) {
        $p =~ s|~1|/|g;
        $p =~ s|~0|~|g;
        if ((ref($data) eq 'HASH') && exists $data->{$p}) { # Hash ref
            $data = $data->{$p}
        } elsif ((ref($data) eq 'ARRAY') && ($p =~ /^[0-9]+$/) && @$data > $p) { # Array ref
            $data = $data->[$p]
        } else { # Not found
            return undef;
        }
    }

lib/Acrux/RefUtil.pm  view on Meta::CPAN


Checks for a regular expression reference generated by the C<qr//> operator

=item is_value

Checks whether I<value> is a primitive value, i.e. a defined, non-ref, and
non-type-glob value

=item is_string

Checks whether I<value> is a string with non-zero-length contents,
equivalent to is_value($value) && length($value) > 0

=item is_number

Checks whether I<value> is a number

=item is_integer, is_int8, is_int16, is_int32, is_int64

Checks whether I<value> is an integer

=item is_undef

lib/Acrux/RefUtil.pm  view on Meta::CPAN

sub is_undef { !defined($_[0]) }
sub is_scalar_ref { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' }
sub is_array_ref { ref($_[0]) eq 'ARRAY' }
sub is_hash_ref { ref($_[0]) eq 'HASH' }
sub is_code_ref { ref($_[0]) eq 'CODE' }
sub is_glob_ref { ref($_[0]) eq 'GLOB' }
sub is_regexp_ref { ref($_[0]) eq 'Regexp' }
sub is_regex_ref { goto &is_regexp_ref }
sub is_rx { goto &is_regexp_ref }
sub is_value { defined($_[0]) && !ref($_[0]) && ref(\$_[0]) ne 'GLOB' }
sub is_string { defined($_[0]) && !ref($_[0]) && (ref(\$_[0]) ne 'GLOB') && length($_[0]) }
sub is_number { (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?(?:[Ee](?:[+-]?\d+))?$/) ? 1 : 0 }
sub is_integer { (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^[+-]?\d+$/) ? 1 : 0 }
sub is_int8 { (defined($_[0]) && !ref($_[0]) && ($_[0] =~ /^[0-9]{1,3}$/) && ($_[0] < 2**8)) ? 1 : 0 }
sub is_int16 { (defined($_[0]) && !ref($_[0]) && ($_[0] =~ /^[0-9]{1,5}$/) && ($_[0] < 2**16)) ? 1 : 0 }
sub is_int32 { (defined($_[0]) && !ref($_[0]) && ($_[0] =~ /^[0-9]{1,10}$/) && ($_[0] < 2**32)) ? 1 : 0 }
sub is_int64 { (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^[0-9]{1,20}$/) ? 1 : 0 }

# Extended
sub is_void {
    my $struct = shift;

lib/Acrux/Util.pm  view on Meta::CPAN


=head2 trim

    print '"'.trim( "    string " ).'"'; # "string"

Returns the string with all leading and trailing whitespace removed.
Trim on undef returns undef. Original this function see String::Util

=head2 truncstr

    print truncstr( $string, $cutoff_length, $continued_symbol );

If the $string is longer than the $cutoff_length, then the string will be truncated
to $cutoff_length characters, including the $continued_symbol
(which defaults to '.' if none is specified).

    print truncstr( "qwertyuiop", 3, '.' ); # q.p
    print truncstr( "qwertyuiop", 7, '.' ); # qw...op
    print truncstr( "qwertyuiop", 7, '*' ); # qw***op

Returns a line the fixed length from 3 to the n chars

See also L<CTK::Util/variant_stf>

=head2 tz_diff

    print tz_diff( time ); # +0300
    print tz_diff( time, ':' ); # +03:00

Returns TimeZone difference value

lib/Acrux/Util.pm  view on Meta::CPAN

    $dth{'%MONTH'} = DTF->{MOY}->[$dt[4] || 0];
    $dth{'%month'} = DTF->{MOY}->[$dt[4] || 0];

    # Second block
    $dth2{'%G'}    = 'GMT' if $g;
    $dth2{'%U'}    = 'UTC' if $g;
    $dth2{'%z'}    = tz_diff($t, ':');
    $dth2{'%Z'}    = $dth2{'%z'}; $dth2{'%Z'} =~ s/\://;
    $dth2{'%%'}    = '%';

    $f =~ s/$_/$dth{$_}/sge for sort { length($b) <=> length($a) } keys %dth;
    $f =~ s/$_/$dth2{$_}/sge for qw/%G %U %Z %z %%/;

    return $f
}
sub dtf { goto &fdt }
sub tz_diff {
    my $tm = shift || time;
    my $chr = shift // '';
    my $diff = Time::Local::timegm(localtime($tm)) - Time::Local::timegm(gmtime($tm));
       $diff  = abs($diff);

lib/Acrux/Util.pm  view on Meta::CPAN

}
sub dformat { # Simple templating processor
    my $f = shift;
    my $d = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    $f =~ s/\[([A-Z0-9_\-.]+?)\]/(defined($d->{$1}) ? $d->{$1} : "[$1]")/eg;
    return $f;
}
sub strf { # Yet another simple templating processor
    my $s = shift // '';
    my $h = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    return '' unless length $s;
    $h->{'%'} //= '%'; # by default '%' eq '%''

    $s =~ s/
            (?:
              %\{(\w+)\}       # short name like %{name}
              |
              %([%a-zA-Z])     # single character specifier like %d
            )
           /
            ( $1

lib/Acrux/Util.pm  view on Meta::CPAN

    my $string = shift // '';
    my $cutoff = shift || 0;
    my $marker = shift // '.';

    # Get dots dumber
    my $dots = 0;
    $cutoff = 3 if $cutoff < 3;
    if ($cutoff < 6) { $dots = $cutoff - 2 }
    else { $dots = 3 }

    # Real length of cutted string
    my $reallenght = $cutoff - $dots;

    # Input string is too short
    return $string if length($string) <= $cutoff;

    # Truncate
    my $fix = floor($reallenght / 2);
    my $new_start = substr($string, 0, ($reallenght - $fix)); # Start part of string
       $new_start =~ s/\s+$//; # trim
    my $new_midle = $marker x $dots; # Middle part of string
    my $new_end   = substr($string, (length($string) - $fix), $fix); # Last part of string
       $new_end   =~ s/^\s+//; # trim
    return sprintf ("%s%s%s", $new_start, $new_midle, $new_end);
}
sub indent {
    my $str = shift // '';
    my $ind = floor(shift || 0);
    my $chr = shift // ' ';
    return $str unless $ind && $ind <= 65535;
    return join '', map { ($chr x $ind) . $_ . "\n" } split /\n/, $str;
}
sub words {
    my @in;
    foreach my $r (@_) {
        if (ref($r) eq 'ARRAY') { push @in, @$r } else { push @in, $r }
    }
    my %o;
    my $i = 0;
    foreach my $s (@in) {
        $s = trim($s // '');
        next unless length($s) && !ref($s);
        foreach my $w (split(/[\s;,]+/, $s)) {
            next unless length($w);
            $o{$w} = ++$i unless exists $o{$w};
        }
    }
    return [sort {$o{$a} <=> $o{$b}} keys %o ];
}

# File utils
sub touch {
    my $fn  = shift // '';
    return 0 unless length($fn);
    my $t = time;
    my $ostat = open my $fh, '>>', $fn;
    unless ($ostat) {
        carp("Can't touch file \"$fn\": $!");
        return 0;
    }
    close $fh if $ostat;
    utime($t, $t, $fn);
    return 1;
}
sub eqtime {
    my $src = shift // '';
    my $dst = shift // '';
    return 0 unless length($src);
    return 0 unless length($dst);
    unless ($src && -e $src) {
        carp("Can't get access and modification times of file \"$src\": no file found");
        return 0;
    }
    unless (utime((stat($src))[8,9], $dst)) {
        carp("Can't change access and modification times on file \"$dst\": $!");
        return 0;
    }
    return 1;
}
sub slurp {
    my $file = shift // '';
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    return unless length($file) && -r $file;
    my $cleanup = 1;

    # Open filehandle
    my $fh;
    if (ref($file)) {
        $fh = $file;
        $cleanup = 0; # Disable closing filehandle for passed filehandle
    } else {
        $fh = IO::File->new($file, "r");
        unless (defined $fh) {

lib/Acrux/Util.pm  view on Meta::CPAN

    $fh->close if $cleanup;

    return 1;
}
sub spurt { goto &spew }

# Colored helper function
sub color {
    my $clr = shift;
    my $txt = (scalar(@_) == 1) ? shift(@_) : sprintf(shift(@_), @_);
    return $txt unless defined($clr) && length($clr);
    return IS_TTY ? colored([$clr], $txt) : $txt;
}

# Misc
sub os_type {
    my $os = shift // $^O;
    return $OSTYPES{$os} || '';
}
sub is_os_type {
    my $type = shift || return;
    return os_type(shift) eq $type;
}

# Copied from ExtUtils::MakeMaker and IO::Prompt::Tiny
sub prompt {
    my $msg = shift // '';
    my $def = shift // '';
    my $dispdef = length($def) ? "[$def] " : " ";

    # Flush vars
    local $|=1;
    local $\;

    # Prompt message
    print length($msg) ? "$msg $dispdef" : "$dispdef";

    my $ans;
    if (!IS_TTY && eof STDIN) {
        print "$def\n";
    } else {
        $ans = <STDIN>;
        if( defined $ans ) {
            chomp $ans;
        } else { # user hit ctrl-D
            print "\n";



( run in 0.854 second using v1.01-cache-2.11-cpan-65fba6d93b7 )