Aion-Format

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
```perl
xxS  # -> 255
```
 
## to_str (;$scalar)
 
Converts to string perl without interpolation.
 
```perl
to_str "a'\n" # => 'a\\'\n'
[map to_str, "a'\n"] # --> ["'a\\'\n'"]
```
 
## from_str (;$one_quote_str)
 
Converts from string perl without interpolation.
 
```perl
from_str "'a\\'\n'"  # => a'\n
[map from_str, "'a\\'\n'"# --> ["a'\n"]
```
 
# SUBROUTINES/METHODS
 
# AUTHOR
 
Yaroslav O. Kosmina <dart@cpan.org>
 
# LICENSE

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

372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
```perl
xxS  # -> 255
```
 
## to_str (;$scalar)
 
Converts to string perl without interpolation.
 
```perl
to_str "a'\n" # => 'a\\'\n'
[map to_str, "a'\n"] # --> ["'a\\'\n'"]
```
 
## from_str (;$one_quote_str)
 
Converts from string perl without interpolation.
 
```perl
from_str "'a\\'\n'"  # => a'\n
[map from_str, "'a\\'\n'"# --> ["a'\n"]
```
 
# SUBROUTINES/METHODS
 
# AUTHOR
 
Yaroslav O. Kosmina <dart@cpan.org>
 
# LICENSE

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

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
#@category Преобразования
 
# Проводит соответствия
#
# matches "...", qr/.../ => sub {...}, ...
#
sub matches($@) {
        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

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

155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
sub from_str(;$) {
        my ($s) = @_ == 0? $_: @_;
        $s =~ s/^'(.*)'\z/$1/s;
        $s =~ s/\\([\\'])/$1/g;
        $s
}
 
# Упрощённый язык регулярок
sub nous($) {
        my ($templates) = @_;
        my $x = join "|", map {
                matches $_,
                # Срезаем все пробелы с конца:
                qr!\s*$! => sub {},
                # Срезаем все начальные строки:
                qr!^([ \t]*\n)*! => sub {},
                # С начала каждой строки 4 пробела или 0-3 пробела и табуляция:
                qr!^( {4}| {0,3}\t)!m => sub {},
                # Пробелы в конце строки и пробельные строки затем заменяем на \s*
                qr!([ \t]*\n)+! => sub { "\\s*" },
                # Заменяем все переменные {{}}:

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

239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
                }
        }
 
        $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 = "";

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

723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
Maximum length in data TinyText mysql and mariadb.
S - small.
 
        xxS  # -> 255
 
=head2 to_str (;$scalar)
 
Converts to string perl without interpolation.
 
        to_str "a'\n" # => 'a\\'\n'
        [map to_str, "a'\n"] # --> ["'a\\'\n'"]
 
=head2 from_str (;$one_quote_str)
 
Converts from string perl 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>

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

1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
# â™       «пики» (карточная масть)    &spades;    &#9824;
spades => 9824,
# ♣   «трефы» (карточная масть)  &clubs;     &#9827;
clubs => 9827,
# ♥   «червы» (карточная масть)  &hearts;    &#9829;
hearts => 9829,
# ♦   «бубны» (карточная масть)  &diams;     &#9830;
diams => 9830,
);
 
sub _set(@) { +{ map { $_ => 1 } @_ } }
 
# Теги не имеющие закрывающего тега
our %SINGLE_TAG = %{ _set qw/area base br col embed hr img input link meta param source track wbr/ };
 
# <li> закрывается, если приходит </ol> или </ul>
our %TOP_CLOSE_TAG = (
        li                      => _set(qw/ol ul/),
        caption         => _set(qw/table/),
        thead           => _set(qw/table/),
        tbody           => _set(qw/table/),

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

1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
my @page;               # массив элементов текста и тегов текущей страницы
my $c = 0;              # количество символов в текущей странице
my $i_page = 0; # индекс элемента @page который привысил размер страницы
my $c_page = 0; # количество символов @page по $i_page
my $is_proposal = 0;                    # Ð’ конце текущей страницы обнаружен конец предложения
my $re_proposal = qr/[.?!…]/;
my @S;                  # массив открывающих тегов [tag, '<tag ...>']
 
# Функция фиксирует страницу и сбрасывает счётчики
my $make_page = sub {
        push @pages, join "", @page, map { "</$_->[0]>" } reverse @S;
        $i_page = $c = $is_proposal = 0;
        @page = map $_->[1], @S;
};
 
for(grep length, split m{(
        <[a-z] [^<>]* >
        | </ \s* [a-z]\w* \s* >
        | &(?: [a-z]\w* | \# \d+ | \#x[0-9a-f]+ ) ;?
        | \n            # Абзац
        | $re_proposal+ # Предложение
        | \b            # Слово
)}xiu, $html) {

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

1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
        $_
}
 
# Все, кроме запрещённых:
#  applet, script, style, embed, object, param,
#  video, audio, source, track, frame, frameset, iframe, comment
#  html, head, body, title, meta, base, basefont, bgsound, link
#  form, keygen, output, textarea, select, option, optgroup, legend, label, input
#  plaintext, xmp
# А так же удаляет атрибуты начинающиеся на "on", name, for, formaction и др..
my %SAFE_TAG = map {$_=>1} qw/
a
abbr
acronym
address
 
area
article
aside
 
b

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

1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
ins
isindex
 
kbd
keygen
 
li
 
main
map
marquee
mark
menu
 
meter
 
nav
nobr
noembed
noframes

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

1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
tt
 
u
ul
 
var
 
wbr
/;
 
my %SAFE_ATTR = map {$_=>1} qw/
pubdate datetime
open optimum
 
dir lang language style tabindex title high low hreflang icon
 
max min
 
href media ping rel rev name type
 
class

lib/Aion/Format/Json.md  view on Meta::CPAN

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
to_json # -> $result
```
 
## from_json (;$string)
 
Parse string in json format to perl structure.
 
```perl
from_json '{"a": 10}' # --> {a => 10}
 
[map from_json, "{}", "2"# --> [{}, 2]
```
 
# AUTHOR
 
Yaroslav O. Kosmina [darviarush@mail.ru](darviarush@mail.ru)
 
# LICENSE
 
âš– **GPLv3**

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

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
         
        local $_ = $data;
        to_json # -> $result
 
=head2 from_json (;$string)
 
Parse string in json format to perl structure.
 
        from_json '{"a": 10}' # --> {a => 10}
         
        [map from_json, "{}", "2"]  # --> [{}, 2]
 
=head1 AUTHOR
 
Yaroslav O. Kosmina LL<mailto:darviarush@mail.ru>
 
=head1 LICENSE
 
âš– B<GPLv3>
 
=head1 COPYRIGHT

lib/Aion/Format/Url.md  view on Meta::CPAN

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
# SUBROUTINES
 
## to_url_param (;$scalar)
 
Escape scalar to part of url search.
 
```perl
to_url_param "a b" # => a+b
 
[map to_url_param, "a b", "🦁"] # --> [qw/a+b %1F981/]
```
 
## to_url_params (;$hash_ref)
 
Generates the search part of the url.
 
```perl
local $_ = {a => 1, b => [[1,2],3,{x=>10}]};
to_url_params  # => a&b[][]&b[][]=2&b[]=3&b[][x]=10
```

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

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
        $param =~ s/${\ UNSAFE_RFC3986}/$& eq " "? "+": sprintf "%%%02X", ord $&/age;
        $param
}
 
sub _escape_url_params {
        my ($key, $param) = @_;
 
        !defined($param)? ():
        $param eq 1? $key:
        ref $param eq "HASH"? do {
                join "&", map _escape_url_params("${key}[$_]", $param->{$_}), sort keys %$param
        }:
        ref $param eq "ARRAY"? do {
                join "&", map _escape_url_params("${key}[]", $_), @$param
        }:
        join "", $key, "=", to_url_param $param
}
 
sub to_url_params(;$) {
        my ($param) = @_ == 0? $_: @_;
 
        if(ref $param eq "HASH") {
                join "&", map _escape_url_params($_, $param->{$_}), sort keys %$param
        }
        else {
                join "&", List::Util::pairmap { _escape_url_params($a, $b) } @$param
        }
}
 
# # Ð’ multipart/form-data
# sub to_multipart(;$) {
#       my ($param) = @_ == 0? $_: @_;
#       $param =~ s/[&=?#+\s]/$& eq " "? "+": sprintf "%%%02X", ord $&/ge;
#       $param
# }

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

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
The utitlities for encode and decode the urls.
 
=head1 SUBROUTINES
 
=head2 to_url_param (;$scalar)
 
Escape scalar to part of url search.
 
        to_url_param "a b" # => a+b
         
        [map to_url_param, "a b", "🦁"] # --> [qw/a+b %1F981/]
 
=head2 to_url_params (;$hash_ref)
 
Generates the search part of the url.
 
        local $_ = {a => 1, b => [[1,2],3,{x=>10}]};
        to_url_params  # => a&b[][]&b[][]=2&b[]=3&b[][x]=10
 
=over

t/aion/format.t  view on Meta::CPAN

372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
done_testing; }; subtest 'xxS ()' => sub {
::is scalar do {xxS}, scalar do{255}, 'xxS  # -> 255';
 
#
# ## to_str (;$scalar)
#
# Converts to string perl without interpolation.
#
done_testing; }; subtest 'to_str (;$scalar)' => sub {
::is scalar do {to_str "a'\n"}, "'a\\'\n'", 'to_str "a\'\n" # => \'a\\\'\n\'';
::is_deeply scalar do {[map to_str, "a'\n"]}, scalar do {["'a\\'\n'"]}, '[map to_str, "a\'\n"] # --> ["\'a\\\'\n\'"]';
 
#
# ## from_str (;$one_quote_str)
#
# Converts from string perl without interpolation.
#
done_testing; }; subtest 'from_str (;$one_quote_str)' => sub {
::is scalar do {from_str "'a\\'\n'"}, "a'\n", 'from_str "\'a\\\'\n\'"  # => a\'\n';
::is_deeply scalar do {[map from_str, "'a\\'\n'"]}, scalar do {["a'\n"]}, '[map from_str, "\'a\\\'\n\'"]  # --> ["a\'\n"]';
 
#
# # SUBROUTINES/METHODS
#
# # AUTHOR
#
# Yaroslav O. Kosmina <dart@cpan.org>
#
# # LICENSE
#

t/aion/format/json.t  view on Meta::CPAN

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
::is scalar do {to_json}, scalar do{$result}, 'to_json # -> $result';
 
#
# ## from_json (;$string)
#
# Parse string in json format to perl structure.
#
done_testing; }; subtest 'from_json (;$string)' => sub {
::is_deeply scalar do {from_json '{"a": 10}'}, scalar do {{a => 10}}, 'from_json \'{"a": 10}\' # --> {a => 10}';
 
::is_deeply scalar do {[map from_json, "{}", "2"]}, scalar do {[{}, 2]}, '[map from_json, "{}", "2"]  # --> [{}, 2]';
 
#
# # AUTHOR
#
# Yaroslav O. Kosmina [darviarush@mail.ru](darviarush@mail.ru)
#
# # LICENSE
#
# âš– **GPLv3**
#

t/aion/format/url.t  view on Meta::CPAN

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
#
# # SUBROUTINES
#
# ## to_url_param (;$scalar)
#
# Escape scalar to part of url search.
#
done_testing; }; subtest 'to_url_param (;$scalar)' => sub {
::is scalar do {to_url_param "a b"}, "a+b", 'to_url_param "a b" # => a+b';
 
::is_deeply scalar do {[map to_url_param, "a b", "🦁"]}, scalar do {[qw/a+b %1F981/]}, '[map to_url_param, "a b", "🦁"] # --> [qw/a+b %1F981/]';
 
#
# ## to_url_params (;$hash_ref)
#
# Generates the search part of the url.
#
done_testing; }; subtest 'to_url_params (;$hash_ref)' => sub {
local $_ = {a => 1, b => [[1,2],3,{x=>10}]};
::is scalar do {to_url_params}, "a&b[][]&b[][]=2&b[]=3&b[][x]=10", 'to_url_params  # => a&b[][]&b[][]=2&b[]=3&b[][x]=10';



( run in 0.303 second using v1.01-cache-2.11-cpan-9b1e4054eb1 )