view release on metacpan or  search on metacpan

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

	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
	в v  к k  с s  ш sh   я ja
	г g  л l  т t  щ sch
	д d  м m  у u  ъ qh
	е e  н n  ф f  ы y
	ё jo о o  х kh ь q
	ж zh	   
	з z
/;
sub transliterate($) {
	my ($s) = @_;
	$s =~ s/[а-яё]/lc($&) eq $&? $TRANS{$&}: ucfirst $TRANS{lc $&}/gier;
}

# Транслитетрирует текст, оставляя только латинские буквы и тире
sub trans($) {
	my ($s) = @_;
	$s = transliterate $s;
	$s =~ s{[-\s_]+}{-}g;
	$s =~ s![^a-z-]!!gi;
	$s =~ s!^-*(.*?)-*\z!$1!;
	lc $s
}

#@category Строки

# Преобразует в строку perl
sub to_str(;$) {

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

	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.2

=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)

Parses a natural number in the specified number system. The default is the 64-digit system.

The symbols used for numbers are 0–9, A–Z, a–z, _, and –. These characters are used before and for the 64 character system. For numbers after the 64-digit system, B<CP1251> encoding characters are used.

	from_radix "A-C" # -> 45004
	from_radix "A-C", 64 # -> 45004
	from_radix "A-C", 255 # -> 666327
	eval { from_radix "A-C", 256 }; $@ 	# ~> The number system 256 is too large. Use NS before 256

=head2 to_radix ($number, $radix)

Converts a natural number to a given number system. The default is the 64-digit system.

	to_radix 10_000 				# => 2SG
	to_radix 10_000, 64 			# => 2SG
	to_radix 10_000, 255 			# => dt
	eval { to_radix 0, 256 }; $@ 	# ~> The number system 256 is too large. Use NS before 256

=head2 kb_size ($number)

Adds numeric digits and adds a unit of measurement.

	kb_size 102             # => 102b
	kb_size 1024            # => 1k