Aion-Format
10 results

 view release on metacpan or  search on metacpan

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

		return sprintf "%.7f ms", $interval*1000 if 0 == int($interval*1000);
		return sprintf "%.8f s", $interval;
	}

	my $hours = int($interval / (60*60));
	my $minutes = int(($interval - $hours*60*60) / 60);
	my $seconds = int($interval - $hours*60*60 - $minutes*60);
	my $last = sprintf "%.3f", $interval - $hours*60*60 - $minutes*60 - $seconds;
	sprintf "%02i:%02i:%02i.%s", $hours, $minutes, $seconds, $last =~ s!^0\.!!r
}

#@category Цифры

# переводит в римскую систему счисления
# N - ноль
# Через каждую 1000 ставится пробел (разделитель разрядов)
our @RIM_CIF = (
	[ '', 'I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX' ],
	[ '', 'X', 'XX', 'XXX', 'XL', 'L', 'LX', 'LXX', 'LXXX', 'XC' ],
	[ '', 'C', 'CC', 'CCC', 'CD', 'D', 'DC', 'DCC', 'DCCC', 'CM' ]
);
sub rim($) {
	my ($a) = @_;
	use bigint; $a+=0;
	my $s;
	for ( ; $a != 0 ; $a = int( $a / 1000 ) ) {
		my $v = $a % 1000;
		if ( $v == 0 ) {
			$s = "M $s";
		}
		else {
			my $d;
			for ( my $i = 0, $d = "" ; $v != 0 ; $v = int( $v / 10 ), $i++ ) {
				my $x = $v % 10;
				$d = $RIM_CIF[$i][$x] . $d;
			}
			$s = "$d $s";
		}
	}

	$s //= "N";
	$s =~ s/ \z//;
	$s
}

# Использованы символы из кодировки cp1251, что нужно для корректной записи в таблицы
our $CIF = join "", "0".."9", "A".."Z", "a".."z", "_-", # 64 символа для 64-ричной системы счисления
	(map chr, ord "А" .. ord "Я"), "ЁЂЃЉЊЌЋЏЎЈҐЄЇІЅ",
	(map chr, ord "а" .. ord "я"), "ёђѓљњќћџўјґєїіѕ",
	"‚„…†‡€‰‹‘’“”•–—™›¤¦§©«¬­®°±µ¶·№»",	do { no utf8; chr 0xa0 }, # небуквенные символы из cp1251
	"!\"#\$%&'()*+,./:;<=>?\@[\\]^`{|}~", # символы пунктуации ASCII
	" ", # пробел
	(map chr, 0 .. 0x1F, 0x7F), # управляющие символы ASCII
	# символ 152 (0x98) в cp1251 отсутствует.
;
# Переводит натуральное число в заданную систему счисления
sub to_radix($;$) {
	use bigint;
	my ($n, $radix) = @_;
	$radix //= 64;
	die "to_radix: The number system $radix is too large. Use NS before " . (1 + length $CIF) if $radix > length $CIF;
	$n+=0; $radix+=0;
	my $x = "";
	for(;;) {
		my $cif_idx = $n % $radix;
		my $cif = substr $CIF, $cif_idx, 1;
		$x =~ s/^/$cif/;
		last unless $n = int($n / $radix);
	}
	return $x;
}

# Парсит натуральное число в указанной системе счисления
sub from_radix(@) {
	use bigint;
	my ($s, $radix) = @_;
	$radix //= 64;
	$radix+=0;
	die "from_radix: The number system $radix is too large. Use NS before " . (1 + length $CIF) if $radix > length $CIF;
	my $x = 0;
	for my $ch (split "", $s) {
		$x = $x*$radix + index $CIF, $ch;
	}
	return $x;
}

# Округляет до указанного разряда числа
sub round($;$) {
	my ($x, $dec) = @_;
	$dec //= 0;
	my $prec = 10**$dec;
	int($x*$prec + 0.5) / $prec
}


#@category Меры (measure)

# добавляет разделители между разрядами числа
sub num($) {
	my ($s) = @_;

	my $sep = " "; # Неразрывный пробел
	my $dec = ".";

	($s, $sep, $dec) = @$s == 2? @$s: (@$s, $dec) if ref $s;

	my ($x, $y) = split /\./, $s;
	$y = "$dec$y" if defined $y;

	$x = reverse $x;
	$x =~ s!\d{3}!$&$sep!g;
	$x =~ s!$sep([+-]?)$!$1!;
	reverse($x) . $y;
}

# Добавляет разряды чисел и добавляет единицу измерения
sub kb_size($) {
	my ($n) = @_;

	return num(round($n / 1024 / 1024 / 1024)) . "G" if $n >= 1024 * 1024 * 1024;
	return num(round($n / 1024 / 1024)) . "M" if $n >= 1024 * 1024;
	return num(round($n / 1024)) . "k" if $n >= 1024;

	return num(round($n)) . "b";
}

# Оставляет $n цифр до и после точки: 10.11 = 10, 0.00012 = 0.00012, 1.2345 = 1.2, если $n = 2
sub sround($;$) {
	my ($number, $digits) = @_;
	$digits //= 2;
	my $num = sprintf("%.100f", $number);
	$num =~ /^-?0?(\d*)\.(0*)[1-9]/;
	return "" . round($num, $digits + length $2) if length($1) == 0;
	my $k = $digits - length $1;
	return "" . round($num, $k < 0? 0: $k);
}

# Кибибайт
sub KiB() { 2**10 }

# Мебибайт
sub MiB() { 2**20 }

# Гибибайт
sub GiB() { 2**30 }

# Тебибайт
sub TiB() { 2**40 }

# Максимум в данных TinyText Марии
sub xxS() { 255 }

# Максимум в данных Text Марии
sub xxR() { 64*KiB-1 }

# Максимум в данных 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

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


=head2 trans ($s)

Transliterates Russian text, leaving only Latin letters and dashes.

	trans "Мир во всём Мире!"  # => mir-vo-vsjom-mire

=head2 transliterate ($s)

Transliterates Russian text.

	transliterate "Мир во всём Мире!"  # => Mir vo vsjom Mire!

=head2 trapperr (&block)

Trap for B<STDERR>.

If there is an error in the block, C<STDOUT> is restored, but the output in the block is lost.

	trapperr { print STDERR "Stars: ✨" }  # => Stars: ✨

See also C<IO::Capture::Stderr>.

=head2 trappout (&block)

Trap for B<STDOUT>.

If there is an error in the block, C<STDOUT> is restored, but the output in the block is lost.

	trappout { print "Stars: ✨" }  # => Stars: ✨
	trappout { print "Stars: ✨"; die "error" }  # @=> error

See also C<IO::Capture::Stdout>.

=head2 TiB ()

The constant is equal to one tebibyte.

	TiB  # -> 2**40

=head2 GiB ()

The constant is equal to one gibibyte.

	GiB  # -> 2**30

=head2 MiB ()

The constant is equal to one mebibyte.

	MiB  # -> 2**20

=head2 KiB ()

The constant is equal to one kibibyte.

	KiB  # -> 2**10

=head2 xxL ()

Maximum length of LongText mysql and mariadb data.
L - large.

	xxL  # -> 4*GiB-1

=head2 xxM ()

Maximum length of MediumText mysql and mariadb data.
M - medium.

	xxM  # -> 16*MiB-1

=head2 xxR ()

Maximum text length of mysql and mariadb data.
R - regularity.

	xxR  # -> 64*KiB-1

=head2 xxS ()

Maximum length of TinyText mysql and mariadb data.
S - small.

	xxS  # -> 255

=head2 to_str (;$scalar)

Convert to Perl string without interpolation.

	to_str "a'\n" # => 'a\\'\n'
	[map to_str, "a'\n"] # --> ["'a\\'\n'"]

=head2 from_str (;$one_quote_str)

Conversion from Perl string without interpolation.

	from_str "'a\\'\n'"  # => a'\n
	[map from_str, "'a\\'\n'"]  # --> ["a'\n"]

=head1 SUBROUTINES/METHODS

=head1 AUTHOR

Yaroslav O. Kosmina L<mailto:dart@cpan.org>

=head1 LICENSE

âš– B<GPLv3>

=head1 COPYRIGHT

Aion::Format is copyright © 2023 by Yaroslav O. Kosmina. Rusland. All rights reserved.



( run in 1.014 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )