Util.pm

gistfile1.pl

package Util;
use strict;
use utf8;

our $VERSION = '0.5';

sub dumper(@) {
	use Data::Dumper;
	
	local $Data::Dumper::Terse = 1; local $Data::Dumper::Indent = 0; local $Data::Dumper::Varname = 0;
	local $Data::Dumper::Maxdepth = 4;
	
	return Dumper @_;
}

#

sub db($;$) {
	my $conf = $_[0] eq __PACKAGE__ ? $_[1] : $_[0];
	
	use DBI 1.58; use DBD::mysql 4.004; use DBI::Util;
	return DBI->connect(DBI::Util::_parse_cfg($conf, {RootClass => 'DBI::Util',
		mysql_enable_utf8    => 1,
		mysql_auto_reconnect => 1,
	}));
}

#

sub find($$) {
	my $list = shift;
	my $item = shift;
	
	my $i=0; $_ eq $item ? return $i : $i++ for @$list;
}

sub gen_rand(;$) {
	my $length = shift || 32;
	return join '', map { map { $_->[rand @$_] } ['A'..'Z', 'a'..'z', 0..9] } 1..$length;
}

#

our $M = {1 => 'Январь', 2 => 'Февраль', 3 => 'Март', 4 => 'Апрель', 5 => 'Май', 6 => 'Июнь', 7 => 'Июль', 8 => 'Август', 9 => 'Сентябрь', 10 => 'Октябрь', 11 => 'Ноябрь', 12 => 'Декабрь'};
our $M_ = {
	map {
		my $v = $M->{$_};
		$v =~ s/(.)$/$1 eq 'т' ? 'та' : 'я'/e;
		($_ => $v)
	} keys %$M
};

sub human2iso($;$) {
	my($date, $time) = split / /, shift;
	my $notime = shift;
	return 
		$notime 
		? join('-', @$_[2,1,0])
		: join ' ', join('-', @$_[2,1,0]), $time 
		for [grep { s/\s+//g;1 } split /\./, $date];
}

sub iso2human {
	my($date, $time) = split / /, (shift || return);
	my $param  = {@_};
	
	return join ' ',
		join('.', map { @$_[2,1,0] } [grep { s/\s+//g;1 } split /\-/, $date]),
		$param->{'notime'} ? () : $time
	;
}

sub iso2humanM($) {
	my ($date, $time) = split / /, shift;
	
	return join ', ',
		join(' ', map { (int $_->[2], lc $M_->{int $_->[1]}, $_->[0]) } [grep { s/\s+//g;1 } split /\-/, $date]),
		[$time =~ /(.*):/]->[0]
	;
}

sub time2iso(;$) {
	return sprintf "%4d-%02d-%02d %02d:%02d:%02d", $_->[5]+1900, $_->[4]+1, reverse @$_[0..3] for [localtime(shift||time)];
}

sub iso2time($) {
	use Time::Local 'timelocal';
	
	for ([reverse map {split('-',$_->[0]), split(':',$_->[1])} [split(' ', shift)]]){
		$_->[4]--;
		return eval { timelocal(@$_) };
	}
}

sub iso2date($) {
	return {
		date => join('.', reverse split /-/, $_->[0]), 
		time => [ $_->[1] =~ /(.*):/ ]->[0],
	} for [split / /, shift];
}

sub iso2str(;$) {
	my $iso = shift;
	use HTTP::Date 'time2str';
	return time2str($iso ? Util::iso2time($iso) : time);
}

sub time2rel($) {
	my $diff = shift;
	my $str;
	
	if    ($diff <                     60) { $str = 'less minute ago' }
	elsif ($diff <                60 * 60) { $str = int($diff /                60)-1 . ' minutes ago' }
	elsif ($diff <           24 * 60 * 60) { $str = int($diff /           24 / 60)-1 .   ' hours ago' }
	elsif ($diff <      31 * 24 * 60 * 60) { $str = int($diff /      31 / 24 / 60)-1 .    ' days ago' }
	elsif ($diff < 12 * 31 * 24 * 60 * 60) { $str = int($diff / 12 / 31 / 24 / 60)-1 .   ' month ago' }
	else                                   { $str = 'more one year ago' }
	
	return $str;
}

#

sub page($$$;$) { shift if $_[0] eq __PACKAGE__;
	my($max, $limit, $page) = @_;
	my $pmax  = int $max / $limit + ($max % $limit > 0 ? 1 : 0);
	my $ppage = int $page || 1;
	
	return {
		'start'  => $_ + 1      > $max ? undef : $_ + 1,
		'end'    => $_ + $limit > $max ? $max  : $_ + $limit,
		
		'prev'   => $ppage >  1 && $ppage <= $pmax ? $ppage - 1 : undef,
		'next'   => $ppage >= 0 && $ppage <  $pmax ? $ppage + 1 : undef,
		'paging' => [1..$pmax],
		
		'page'   => $ppage,
		'limit'  => $limit,
		'max'    => $max,
	} for ($ppage - 1) * $limit;
}

sub tags {
	my $level = 24;
	my $list  = [map { $_->{cnt} } @{$_[0]}];
	
	use List::Util qw(min max);
	
	my $max = log(max @$list);
	my $min = log(min @$list);
	my $factor;
	
	# special case all tags having the same count
	if ($max - $min == 0) {
		$min = $min - $level;
		$factor = 1;
	} else {
		$factor = $level / ($max - $min);
	}
	
	if (scalar @$list < $level ) {
		$factor *= (scalar @$list/$level);
	}
	
	$_->{size} = int((log($_->{cnt}) - $min) * $factor) for @{$_[0]};
	
	return $_[0];
}

sub declension($@) {
	my ($n, $one, $one_, $many) = @_;
	return
		$n%10 == 1
			 ?
				$n%100 == 11
				 ?
					$many
				 :
					$one
			 :
				(grep {$n%10 == $_} 2..4)
				 ?
					(grep {$n%100 == $_} 12..14)
					 ?
						$many
					 :
						$one_
				 :
					$many
	;
}

sub clean_html($) {
	for (my $str = shift) {
		s{<[^>]+>}{ }sg;
		return $_;
	}
}

sub text2link($) {
	for (my $str = shift) {
		s{( http:// (?: [^"'\s]+ | $ ) )}{<a href="$1" target="_blank">$1</a>}xsg;
		s{(?:\n)+}{<br/>}sg;
		return $_;
	}
}

#

sub trim($) {
	for (my $str = shift) {
		s/^\s+//;
		s/\s+$//;
		s/\s+/_/g;
		
		s/\W/_/g;
		
		s/^_+//;
		s/_+$//;
		s/_+/_/g;
		
		return lc;
	}
}

#

sub win2translit($) {
	for (my $str = shift) {
		# XXX
		use Encode ();
		Encode::_utf8_on($_) unless Encode::is_utf8($_);
		
		s/льз/les/g;
		
		s/Сх/S\'h/; s/сх/s\'h/; s/СХ/S\'H/;
		s/Ш/Sh/g; s/ш/sh/g;
		
		s/Сцх/Sc\'h/; s/сцх/sc\'h/; s/СЦХ/SC\'H/;
		s/Щ/Sch/g; s/щ/sch/g;
		
		s/Цх/C\'h/; s/цх/c\'h/; s/ЦХ/C\'H/;
		s/Ч/Ch/g; s/ч/ch/g;
		
		s/Йа/J\'a/; s/йа/j\'a/; s/ЙА/J\'A/;
		s/Я/Ya/g; s/я/ya/g;
		
		s/Йо/J\'o/; s/йо/j\'o/; s/ЙО/J\'O/;
		s/Ё/Jo/g; s/ё/jo/g;
		
		s/Йу/J\'u/; s/йу/j\'u/; s/ЙУ/J\'U/;
		s/Ю/U/g; s/ю/u/g;
		
		s/Э/E\'/g; s/э/e\'/g;
		s/Е/E/g; s/е/e/g;
		
		s/Зх/Z\'h/g; s/зх/z\'h/g; s/ЗХ/Z\'H/g;
		s/Ж/Zh/g; s/ж/zh/g;
		
		tr/
		абвгдзийклмнопрстуфхцъыьАБВГДЗИЙКЛМНОПРСТУФХЦЪЫЬ/
		abvgdzijklmnoprstufhc\"y\'ABVGDZIJKLMNOPRSTUFHC\"Y\'/; #"
		
		return $_;
	}
}

sub translit2win($) {
	for (my $str = shift) {
		s/E\'/Э/g; s/e\'/э/g;
		s/E/Е/g; s/e/е/g;
		
		s/Jo/Ё/g; s/jo/ё/g;
		s/J\'o/Йо/g; s/j\'o/йо/g; s/J\'O/ЙО/g;
		
		s/Sch/Щ/g; s/sch/щ/g;
		s/Sc\'h/Сцх/g; s/sc\'h/сцх/g; s/SC\'H/СЦХ/g;
		
		s/Ch/Ч/g; s/ch/ч/g;
		s/C\'h/Цх/g; s/c\'h/цх/g; s/C\'H/ЦХ/g;
		
		s/Sh/Ш/g; s/sh/ш/g;
		s/S\'h/Сх/g; s/s\'h/сх/g; s/S\'H/СХ/g;
		
		s/Ja/Я/g; s/ja/я/g;
		s/J\'a/Йа/g; s/j\'a/йа/g; s/J\'A/ЙА/g;
		
		s/Zh/Ж/g; s/zh/ж/g;
		s/Z\'h/Зх/g; s/z\'h/зх/g; s/Z\'H/ЗХ/g;
		
		s/Ju/Ю/g; s/ju/ю/g;
		s/J\'u/Йу/g; s/j\'u/йу/g; s/J\'U/ЙУ/g;
		
		tr/
		abvgdzijklmnoprstufhc\"y\'ABVGDZIJKLMNOPRSTUFHC\"Y\'/
		абвгдзийклмнопрстуфхцъыьАБВГДЗИЙКЛМНОПРСТУФХЦЪЫЬ/; #"
		
		return $_;
	}
}

#

sub group {
	my $data  = shift;
	my $group = shift;
	
	my $h;
	push @{$h->{$_->{$group}}},$_ for @$data;
	
	[map {+{
		'group' => $_->[0]->{$group},
		'data'  => @_ ? group($_,@_) : $_,
	}} values %$h];
}

1;