view release on metacpan or  search on metacpan

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

	my ($s) = @_ == 0? $_: @_;
	$s =~ s/[\\']/\\$&/g;
	$s =~ s/^(.*)\z/'$1'/s;
	$s
}

# Преобразует из строки perl
sub from_str(;$) {
	my ($s) = @_ == 0? $_: @_;
	$s =~ s/^'(.*)'\z/$1/s;
	$s =~ s/\\([\\'])/$1/g;
	$s
}

# Упрощённый язык регулярок
sub nous($) {
	my ($templates) = @_;
	my $x = join "|", map {
		replace $_,
		# Срезаем все пробелы с конца:
		qr!\s*$! => sub {},
		# Срезаем все начальные строки:
		qr!^([ \t]*\n)*! => sub {},
		# С начала каждой строки 4 пробела или 0-3 пробела и табуляция:
		qr!^( {4}| {0,3}\t)!m => sub {},
		# Пробелы в конце строки и пробельные строки затем заменяем на \s*
		qr!([ \t]*\n)+! => sub { "\\s*" },
		# Заменяем все переменные {{}}:
		qr!\{\{(?<type>[>:])?\s*(?<name>[a-z_]\w*)\s*\}\}!i => sub { 
			"(?<$+{name}>" . (
				$+{type} eq ">"? "[^<>]*?": 
				$+{type} eq ":"? "[^\n]*": 
								 ".*?"
			) . ")" 
		},
		# Заменяем управляющие последовательности:
		qr!\[\[! => sub { "(" },
		qr!\]\]! => sub { ")?" },
		qr!\(\(! => sub { "(" },
		qr!\)\)! => sub { ")" },
		qr!\|\|! => sub { "|" },
		# Остальное - эскейпим:
		qr!.*?! => sub { quotemeta $& },
	} @$templates;
	
	qr/$x/xsmn
}

# формирует человекочитабельный интервал
sub sinterval($) {
	my ($interval) = @_;

	if(0 == int $interval) {
		return sprintf "%.6f mks", $interval*1000_000 if 0 == int($interval*1000_000);
		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);
	}