view release on metacpan or  search on metacpan

t/aion/format.t  view on Meta::CPAN

use common::sense; use open qw/:std :utf8/;  use Carp qw//; use Cwd qw//; use File::Basename qw//; use File::Find qw//; use File::Slurper qw//; use File::Spec qw//; use File::Path qw//; use Scalar::Util qw//;  use Test::More 0.98;  use String::Diff q...
# # NAME
# 
# Aion::Format - расширение Perl для форматирования чисел, раскрашивания вывода и т.п.
# 
# # VERSION
# 
# 0.1.1
# 
# # SYNOPSIS
# 
subtest 'SYNOPSIS' => sub { 
use Aion::Format;

local ($::_g0 = do {trappout { print "123\n" }}, $::_e0 = "123\n"); ::ok $::_g0 eq $::_e0, 'trappout { print "123\n" } # => 123\n' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

local ($::_g0 = do {coloring "#red ↬ #r\n"}, $::_e0 = "\e[31m ↬ \e[0m\n"); ::ok $::_g0 eq $::_e0, 'coloring "#red ↬ #r\n" # => \e[31m ↬ \e[0m\n' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {trappout { printcolor "#red ↬ #r\n" }}, $::_e0 = "\e[31m ↬ \e[0m\n"); ::ok $::_g0 eq $::_e0, 'trappout { printcolor "#red ↬ #r\n" } # => \e[31m ↬ \e[0m\n' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e...

# 
# # DESCRIPTION
# 
# Утилиты для форматирования чисел, раскрашивания вывода и т.п.
# 
# # SUBROUTINES
# 
# ## coloring ($format, @params)
# 
# Раскрашивает текст с помощью escape-последовательностей, а затем заменяет формат на `sprintf`. Названия цветов используются из модуля `Term::ANSICol...
# 
::done_testing; }; subtest 'coloring ($format, @params)' => sub { 
local ($::_g0 = do {coloring "#{BOLD RED}###r %i", 6}, $::_e0 = "\e[1;31m##\e[0m 6"); ::ok $::_g0 eq $::_e0, 'coloring "#{BOLD RED}###r %i", 6 # => \e[1;31m##\e[0m 6' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## printcolor ($format, @params)
# 
# Как `coloring`, но печатает отформатированную строку на стандартный вывод.
# 
# ## warncolor ($format, @params)
# 
# Как `coloring`, но печатает отформатированную строку в `STDERR`.
# 
::done_testing; }; subtest 'warncolor ($format, @params)' => sub { 
local ($::_g0 = do {trapperr { warncolor "#{green}ACCESS#r %i\n", 6 }}, $::_e0 = "\e[32mACCESS\e[0m 6\n"); ::ok $::_g0 eq $::_e0, 'trapperr { warncolor "#{green}ACCESS#r %i\n", 6 }  # => \e[32mACCESS\e[0m 6\n' or ::diag ::_string_diff($::_g0, $::_e0)...

# 
# ## accesslog ($format, @params)
# 
# Пишет в STDOUT используя для форматирования функцию `coloring` и добавляет префикс с датой-временем.
# 
::done_testing; }; subtest 'accesslog ($format, @params)' => sub { 
::like scalar do {trappout { accesslog "#{green}ACCESS#r %i\n", 6 }}, qr{\[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[32mACCESS\e\[0m 6\n}, 'trappout { accesslog "#{green}ACCESS#r %i\n", 6 }  # ~> \[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[32mACCESS\e\[0m ...

# 
# ## errorlog ($format, @params)
# 
# Пишет в **STDERR** используя для форматирования функцию `coloring` и добавляет префикс с датой-временем.
# 
::done_testing; }; subtest 'errorlog ($format, @params)' => sub { 
::like scalar do {trapperr { errorlog "#{red}ERROR#r %i\n", 6 }}, qr{\[\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d\] \e\[31mERROR\e\[0m 6\n}, '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'; unde...

# 
# ## p ($target; %properties)
# 
# `p` из Data::Printer с предустановленными настройками.
# 
# Вместо неудобного первого параметра используется просто скаляр.
# 
# Необязательный параметр `%properties` позволяет перекрывать настройки. 
# 
::done_testing; }; subtest 'p ($target; %properties)' => sub { 
::like scalar do {trapperr { p +{cat => 123} }}, qr{cat.+123}, 'trapperr { p +{cat => 123} } # ~> cat.+123'; undef $::_g0; undef $::_e0;

# 
# ## np ($target; %properties)
# 
# `np` из Data::Printer с предустановленными настройками.
# 
# Вместо неудобного первого параметра используется просто скаляр.
# 
# Необязательный параметр `%properties` позволяет перекрывать настройки. 
# 
::done_testing; }; subtest 'np ($target; %properties)' => sub { 
::like scalar do {np +{cat => 123}}, qr{cat.+123}, 'np +{cat => 123} # ~> cat.+123'; undef $::_g0; undef $::_e0;

# 
# ## flesch_index_human ($flesch_index)
# 
# Преобразует индекс Флеша в русскоязычную метку с помощью шага 10.
# 
::done_testing; }; subtest 'flesch_index_human ($flesch_index)' => sub { 
local ($::_g0 = do {flesch_index_human -10}, $::_e0 = "несвязный русский текст"); ::ok $::_g0 eq $::_e0, 'flesch_index_human -10   # => несвязный русский текст' or ::diag ::_string_diff($::_g0, $::_e0); undef...
local ($::_g0 = do {flesch_index_human -3}, $::_e0 = "для академиков"); ::ok $::_g0 eq $::_e0, 'flesch_index_human -3    # => для академиков' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {flesch_index_human 0}, $::_e0 = "для академиков"); ::ok $::_g0 eq $::_e0, 'flesch_index_human 0     # => для академиков' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {flesch_index_human 1}, $::_e0 = "для академиков"); ::ok $::_g0 eq $::_e0, 'flesch_index_human 1     # => для академиков' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {flesch_index_human 15}, $::_e0 = "для профессионалов"); ::ok $::_g0 eq $::_e0, 'flesch_index_human 15    # => для профессионалов' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_...
local ($::_g0 = do {flesch_index_human 99}, $::_e0 = "для 11 лет (уровень 5-го класса)"); ::ok $::_g0 eq $::_e0, 'flesch_index_human 99    # => для 11 лет (уровень 5-го класса)' or ::diag ::_string_diff($::_g...
local ($::_g0 = do {flesch_index_human 100}, $::_e0 = "для младшеклассников"); ::ok $::_g0 eq $::_e0, 'flesch_index_human 100   # => для младшеклассников' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; u...
local ($::_g0 = do {flesch_index_human 110}, $::_e0 = "несвязный русский текст"); ::ok $::_g0 eq $::_e0, 'flesch_index_human 110   # => несвязный русский текст' or ::diag ::_string_diff($::_g0, $::_e0); undef...

# 
# ## from_radix ($string, $radix)
# 
# Анализирует натуральное число в указанной системе счисления. По умолчанию используется 64-значная система.
# 
# Для цифр используются символы 0–9, A–Z, a–z, _ и –. Эти символы используются до и для 64 значной системы. Для цифр после 64 значной системы исÐ...
# 
::done_testing; }; subtest 'from_radix ($string, $radix)' => sub { 
local ($::_g0 = do {from_radix "A-C"}, $::_e0 = do {45004}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'from_radix "A-C" # -> 45004' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {from_radix "A-C", 64}, $::_e0 = do {45004}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'from_radix "A-C", 64 # -> 45004' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {from_radix "A-C", 255}, $::_e0 = do {666327}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'from_radix "A-C", 255 # -> 666327' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
::like scalar do {eval { from_radix "A-C", 256 }; $@}, qr{The number system 256 is too large. Use NS before 256}, 'eval { from_radix "A-C", 256 }; $@ 	# ~> The number system 256 is too large. Use NS before 256'; undef $::_g0; undef $::_e0;

# 
# ## to_radix ($number, $radix)
# 
# Преобразует натуральное число в заданную систему счисления. По умолчанию используется 64-значная система.
# 
::done_testing; }; subtest 'to_radix ($number, $radix)' => sub { 
local ($::_g0 = do {to_radix 10_000}, $::_e0 = "2SG"); ::ok $::_g0 eq $::_e0, 'to_radix 10_000 				# => 2SG' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

t/aion/format.t  view on Meta::CPAN

::done_testing; }; subtest 'sinterval ($interval)' => sub { 
local ($::_g0 = do {sinterval  6666.6666}, $::_e0 = "01:51:06.667"); ::ok $::_g0 eq $::_e0, 'sinterval  6666.6666 	# => 01:51:06.667' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sinterval  6.6666}, $::_e0 = "00:00:06.667"); ::ok $::_g0 eq $::_e0, 'sinterval  6.6666 		# => 00:00:06.667' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sinterval  .333}, $::_e0 = "0.33300000 s"); ::ok $::_g0 eq $::_e0, 'sinterval  .333 		# => 0.33300000 s' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sinterval  .000_33}, $::_e0 = "0.3300000 ms"); ::ok $::_g0 eq $::_e0, 'sinterval  .000_33 		# => 0.3300000 ms' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sinterval  .000_000_33}, $::_e0 = "0.330000 mks"); ::ok $::_g0 eq $::_e0, 'sinterval  .000_000_33 	# => 0.330000 mks' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## sround ($number, $digits)
# 
# Оставляет `$digits` цифр после последнего нуля (сам 0 не учитывается).
# 
# По умолчанию `$digits` равен 2.
# 
::done_testing; }; subtest 'sround ($number, $digits)' => sub { 
local ($::_g0 = do {sround 10.11}, $::_e0 = do {10}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 10.11        # -> 10' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sround 12.11}, $::_e0 = do {12}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 12.11        # -> 12' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sround 100.11}, $::_e0 = do {100}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 100.11       # -> 100' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sround 133.11}, $::_e0 = do {133}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 133.11       # -> 133' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sround 0.00012}, $::_e0 = do {0.00012}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 0.00012      # -> 0.00012' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sround 1.2345}, $::_e0 = do {1.2}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 1.2345       # -> 1.2' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {sround 1.2345, 3}, $::_e0 = do {1.23}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'sround 1.2345, 3    # -> 1.23' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## trans ($s)
# 
# Транслитерирует русский текст, оставляя только латинские буквы и тире.
# 
::done_testing; }; subtest 'trans ($s)' => sub { 
local ($::_g0 = do {trans "Мир во всём Мире!"}, $::_e0 = "mir-vo-vsjom-mire"); ::ok $::_g0 eq $::_e0, 'trans "Мир во всём Мире!"  # => mir-vo-vsjom-mire' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## transliterate ($s)
# 
# Транслитерирует русский текст.
# 
::done_testing; }; subtest 'transliterate ($s)' => sub { 
local ($::_g0 = do {transliterate "Мир во всём Мире!"}, $::_e0 = "Mir vo vsjom Mire!"); ::ok $::_g0 eq $::_e0, 'transliterate "Мир во всём Мире!"  # => Mir vo vsjom Mire!' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_...

# 
# ## trapperr (&block)
# 
# Ловушка для **STDERR**.
# 
# В случае ошибки в блоке `STDOUT` восстанавливается, а вывод в блоке – теряется.
# 
::done_testing; }; subtest 'trapperr (&block)' => sub { 
local ($::_g0 = do {trapperr { print STDERR "Stars: ✨" }}, $::_e0 = "Stars: ✨"); ::ok $::_g0 eq $::_e0, 'trapperr { print STDERR "Stars: ✨" }  # => Stars: ✨' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# См. также `IO::Capture::Stderr`.
# 
# ## trappout (&block)
# 
# Ловушка для **STDOUT**.
# 
# В случае ошибки в блоке `STDOUT` восстанавливается, а вывод в блоке – теряется.
# 
::done_testing; }; subtest 'trappout (&block)' => sub { 
local ($::_g0 = do {trappout { print "Stars: ✨" }}, $::_e0 = "Stars: ✨"); ::ok $::_g0 eq $::_e0, 'trappout { print "Stars: ✨" }  # => Stars: ✨' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
eval {trappout { print "Stars: ✨"; die "error" }}; local ($::_g0 = $@, $::_e0 = "error"); ok defined($::_g0) && $::_g0 =~ /^${\quotemeta $::_e0}/, 'trappout { print "Stars: ✨"; die "error" }  # @=> error' or ::diag ::_string_diff($::_g0, $::_e0, ...

# 
# См. также `IO::Capture::Stdout`.
# 
# ## TiB ()
# 
# Константа равна одному тебибайту.
# 
::done_testing; }; subtest 'TiB ()' => sub { 
local ($::_g0 = do {TiB}, $::_e0 = do {2**40}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'TiB  # -> 2**40' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## GiB ()
# 
# Константа равна одному гибибайту.
# 
::done_testing; }; subtest 'GiB ()' => sub { 
local ($::_g0 = do {GiB}, $::_e0 = do {2**30}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'GiB  # -> 2**30' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## MiB ()
# 
# Константа равна одному мебибайту.
# 
::done_testing; }; subtest 'MiB ()' => sub { 
local ($::_g0 = do {MiB}, $::_e0 = do {2**20}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'MiB  # -> 2**20' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## KiB ()
# 
# Константа равна одному кибибайту.
# 
::done_testing; }; subtest 'KiB ()' => sub { 
local ($::_g0 = do {KiB}, $::_e0 = do {2**10}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'KiB  # -> 2**10' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## xxL ()
# 
# Максимальная длина данных LongText mysql и mariadb.
# L - large.
# 
::done_testing; }; subtest 'xxL ()' => sub { 
local ($::_g0 = do {xxL}, $::_e0 = do {4*GiB-1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'xxL  # -> 4*GiB-1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## xxM ()
# 
# Максимальная длина данных MediumText mysql и mariadb.
# M - medium.
# 
::done_testing; }; subtest 'xxM ()' => sub { 
local ($::_g0 = do {xxM}, $::_e0 = do {16*MiB-1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'xxM  # -> 16*MiB-1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## xxR ()
# 
# Максимальная длина текста данных mysql и mariadb.
# R - regularity.
# 
::done_testing; }; subtest 'xxR ()' => sub {