view release on metacpan or  search on metacpan

lib/Aion/Format.pm  view on Meta::CPAN

package Aion::Format;
# Библиотека форматирования и вывода

use common::sense;

our $VERSION = "0.1.3";

require POSIX;
require Term::ANSIColor;
use Guard qw//;

use Exporter qw/import/;
our @EXPORT = our @EXPORT_OK = grep {
	*{$Aion::Format::{$_}}{CODE} && !/^(_|(NaN|import)\z)/n
} keys %Aion::Format::;


#@category Вывод структур

use DDP qw//;

sub _extends_ddp_properties {
	my ($properties) = @_;
	+{
		colored => 1,
		deparse => 1,
		show_unicode => 1,
		show_readonly => 1,
		print_escapes => 1,
		show_refcount => 1,
		show_memsize => eval { require Devel::Size; 1 },
		caller_info => 1,
		#output => 'stdout',
		unicode_charnames => 1,
		%$properties,
		class => {
			expand => "all",
			inherited => "all",
			show_reftype => 1,
			%{$properties->{class}},
		},
	}
}

# p с предустановленными опциями
sub p($;%) {
	my ($arg, %properties) = @_;
	%properties = %{_extends_ddp_properties(\%properties)};
	DDP::p $arg, %properties
}

# np с предустановленными опциями
sub np($;%) {
	my ($arg, %properties) = @_;
	%properties = %{_extends_ddp_properties(\%properties)};
	DDP::np $arg, %properties
}

#@category Ловушки

# Ловушка для STDERR
sub trapperr(&) {
	my $sub = shift;
	local *STDERR;
	open STDERR, '>:utf8', \my $f; my $guard = Guard::guard { close STDERR };
	$sub->();
	undef $guard;
	utf8::decode($f) unless utf8::is_utf8($f);
	$f
}

# Ловушка для STDOUT
sub trappout(&) {
	my $sub = shift;
	local *STDOUT;
	open STDOUT, '>:utf8', \my $f; my $guard = Guard::guard { close STDOUT };
	$sub->();
	undef $guard;
	utf8::decode($f) unless utf8::is_utf8($f);
	$f
}

#@category Цвет

# Колоризирует текст escape-последовательностями: coloring("#{BOLD RED}ya#{}100!#RESET"), а затем - заменяет формат sprintf-ом
sub coloring(@) {
	my $s = shift;
	$s =~ s!#\{(?<x>[\w \t]*)\}|#(?<x>\w+)!
		my $x = $+{x};
		$x = "RESET" if $x ~~ [qw/r R/];
		Term::ANSIColor::color($x)
	!nge;
	sprintf $s, @_
}

# Печатает в STDOUT вывод coloring
sub printcolor(@) {
	print coloring @_
}

# Печатает в STDERR вывод coloring
sub warncolor(@) {
	print STDERR coloring @_
}

# Для крона: Пишет в STDOUT
sub accesslog(@) {
	print "[", POSIX::strftime("%F %T", localtime), "] ", coloring @_;
}

# Для крона: Пишет в STDIN
sub errorlog(@) {
	print STDERR "[", POSIX::strftime("%F %T", localtime), "] ", coloring @_;
}


#@category Преобразования

# Проводит соответствия
#
# replace "...", qr/.../ => sub {...}, ...
#
sub matches($@) { goto &replace }
sub replace($@) {
	my $s = shift;
	my $i = 0;
	my $re = join "\n| ", map { $i++ % 2 == 0? "(?<I$i> $_ )": () } @_;
	my $arg = \@_;
	my $fn = sub {
		for my $k (keys %+) {
			return $arg->[$k]->() if do { $k =~ /^I(\d+)\z/ and $k = $1 }
		}
	};

	$s =~ s/$re/$fn->()/gex;

	$s
}

#@category Транслитерация

# Транслитетрирует русский текст (x, w, q)
our %TRANS = qw/
	а a  и i  п p  ц c	э eh
	б b  й y  р r  ч ch   ю ju

lib/Aion/Format.pm  view on Meta::CPAN

# Максимум в данных MediumText Марии
sub xxM() { 16*MiB-1 }

# Максимум в данных LongText Марии
sub xxL() { 4*GiB-1 }

#@category Конверторы

# Маппинг индекса Флеша для человеков
my %FLESCH_INDEX_NAMES = (
	100 => "для младшеклассников",
	90 => "для 11 лет (уровень 5-го класса)",
	80 => "для 12 лет (6-й класс)",
	70 => "для 13 лет (7-й класс)",
	60 => "для 8-х и 9-х классов",
	50 => "для 10-х, 12-х классов",
	40 => "для студентов",
	30 => "для бакалавров",
	20 => "для магистров",
	10 => "для профессионалов",
	0 => "для академиков",
);

sub flesch_index_human($) {
	my ($flesch_index) = @_;
	$FLESCH_INDEX_NAMES{int($flesch_index / 10) * 10} // "несвязный русский текст"
}

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Format - a Perl extension for formatting numbers, coloring output, etc.

=head1 VERSION

0.1.3

=head1 SYNOPSIS

	use Aion::Format;
	
	trappout { print "123\n" } # => 123\n
	
	coloring "#red ↬ #r\n" # => \e[31m ↬ \e[0m\n
	trappout { printcolor "#red ↬ #r\n" } # => \e[31m ↬ \e[0m\n

=head1 DESCRIPTION

Utilities for formatting numbers, coloring output, etc.

=head1 SUBROUTINES

=head2 coloring ($format, @params)

Colorizes text using escape sequences and then replaces the format with C<sprintf>. The color names are used from the C<Term::ANSIColor> module. For B<RESET> use C<#r> or C<#R>.

	coloring "#{BOLD RED}###r %i", 6 # => \e[1;31m##\e[0m 6

=head2 printcolor ($format, @params)

Like C<coloring>, but prints the formatted string to standard output.

=head2 warncolor ($format, @params)

Like C<coloring>, but prints the formatted string to C<STDERR>.

	trapperr { warncolor "#{green}ACCESS#r %i\n", 6 }  # => \e[32mACCESS\e[0m 6\n

=head2 accesslog ($format, @params)

Writes to STDOUT using the C<coloring> function for formatting and adds a date-time prefix.

	trappout { accesslog "#{green}ACCESS#r %i\n", 6 }  # ~> \[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[32mACCESS\e\[0m 6\n

=head2 errorlog ($format, @params)

Writes to B<STDERR> using the C<coloring> function for formatting and adds a date-time prefix.

	trapperr { errorlog "#{red}ERROR#r %i\n", 6 }  # ~> \[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[31mERROR\e\[0m 6\n

=head2 p ($target; %properties)

C<p> from Data::Printer with preset settings.

Instead of the inconvenient first parameter, a simple scalar is used.

The optional C<%properties> parameter allows you to override settings.

	trapperr { p +{cat => 123} } # ~> cat.+123

=head2 np ($target; %properties)

C<np> from Data::Printer with preset settings.

Instead of the inconvenient first parameter, a simple scalar is used.

The optional C<%properties> parameter allows you to override settings.

	np +{cat => 123} # ~> cat.+123

=head2 flesch_index_human ($flesch_index)

Converts the Flesch index to a Russian label using step 10.

	flesch_index_human -10   # => несвязный русский текст
	flesch_index_human -3    # => для академиков
	flesch_index_human 0     # => для академиков
	flesch_index_human 1     # => для академиков
	flesch_index_human 15    # => для профессионалов
	flesch_index_human 99    # => для 11 лет (уровень 5-го класса)
	flesch_index_human 100   # => для младшеклассников
	flesch_index_human 110   # => несвязный русский текст

=head2 from_radix ($string, $radix)