view release on metacpan or  search on metacpan

t/aion/format/url.pm  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...
# 
# use common::sense;
# 
# use List::Util qw//;
# use Encode qw//;
# 
# use Exporter qw/import/;
# our @EXPORT = our @EXPORT_OK = grep {
# 	ref \$Aion::Format::Url::{$_} eq "GLOB"
# 		&& *{$Aion::Format::Url::{$_}}{CODE} && !/^(_|(NaN|import)\z)/n
# } keys %Aion::Format::Url::;
# 
# 
# #@category escape url
# 
# use constant UNSAFE_RFC3986 => qr/[^A-Za-z0-9\-\._~]/;
# 
# # Эскейпит значение
# sub to_url_param(;$) {
# 	my ($param) = @_ == 0? $_: @_;
# 	use bytes;
# 	$param =~ s/${\ UNSAFE_RFC3986}/$& eq " "? "+": sprintf "%%%02X", ord $&/ge;
# 	$param
# }
# 
# # Преобразует в формат url-параметров
# sub to_url_params(;$) {
# 	my ($param) = @_ == 0? $_: @_;
# 
# 	my @R;
# 	my @S = [$param];
# 	while(@S) {
# 		my $u = pop @S;
# 		my ($x, $key) = @$u;
# 		
# 		if(ref $x eq "HASH") {
# 			push @S, defined($key)
# 				? (map [$x->{$_}, "$key\[${\to_url_param}]"], sort keys %$x)
# 				: (map [$x->{$_}, to_url_param], sort keys %$x)
# 			;
# 		}
# 		elsif(ref $x eq "ARRAY") {
# 			push @S, map [$_, "$key\[]"], @$x;
# 		}
# 		elsif(!defined $x) {}
# 		elsif($x eq 1) { unshift @R, $key }
# 		else {
# 			unshift @R, join "=", $key, to_url_param $x;
# 		}
# 	}
# 	
# 	join "&", @R
# }
# 
# # Определяет кодировку. В koi8-r и в cp1251 большие и малые буквы как бы поменялись местами, поэтому у правильной кодировки вес будет больше
# sub _bohemy {
# 	my ($s) = @_;
# 	my $c = 0;
# 	while($s =~ /[а-яё]+/gi) {
# 		my $x = $&;
# 		if($x =~ /^[А-ЯЁа-яё][а-яё]*$/) { $c += length $x } else { $c -= length $x }
# 	}
# 	$c
# }
# 
# sub from_url_param(;$) {
# 	my ($param) = @_ == 0? $_: @_;
# 
# 	utf8::encode($param) if utf8::is_utf8($param);
# 
# 	{
# 		no utf8;
# 		use bytes;
# 		$param =~ s!\+! !g;
# 		$param =~ s!%([\da-f]{2})! chr hex $1 !age;
# 	}
# 
# 	eval { $param = Encode::decode_utf8($param, Encode::FB_CROAK) };
# 
# 	if($@) { # видимо тут кодировка cp1251 или koi8-r
# 		my $cp  = Encode::decode('cp1251', $param);
# 		my $koi = Encode::decode('koi8-r', $param);
# 		# выбираем перекодировку в которой меньше больших букв внутри слова
# 		$param = _bohemy($koi) > _bohemy($cp)? $koi: $cp;
# 	}
# 
# 	$param
# }
# 
# sub from_url_params(;$) {
# 	my ($param) = @_ == 0? $_: @_;
# 
# 	my %param;
# 
# 	for(split /&/, $param) {
# 		my ($key, $v) = /=/ ? ($`, $'): ($_, 1);
# 
# 		my @keys = split /(?:\]\[|[\[\]])/, $key;
# 		use DDP; p my $x=\@keys;
# 		my $x = \%param;
# 		for my $k (@keys) {
# 			if($k eq "") {
# 				use DDP; p my $x=["arr!", $k, $x, ref $x];
# 				$x = \$x->[$#$x] }
# 			else {
# 				use DDP; p my $x=["h!", $k, $x, ref $x];
# 				$x = \$x->{from_url_param $k};
# 			}
# 		}
# 
# 		$$x = from_url_param $v;
# 	}
# 
# 	\%param
# }
# 
# #@category parse url
# 
# sub _parse_url ($) {
# 	my ($link) = @_;
# 	$link =~ m!^
# 		( (?<proto> \w+ ) : )?
# 		( //
# 			( (?<user> [^:/?\#\@]* ) :
# 		  	  (?<pass> [^/?\#\@]*  ) \@  )?
# 			(?<domain> [^/?\#]* )			 )?
# 		(  / (?<path>  [^?\#]* ) )?
# 		(?<part> [^?\#]+ )?
# 		( \? (?<query> [^\#]*  ) )?
# 		( \# (?<hash>  .*	   ) )?
# 	\z!xn;
# 	return %+;
# }
# 
# # 1 - set / in each page, if it not file (*.*), or 0 - unset
# use config DIR => 0;
# use config ONPAGE => "off://off";
#