App-SahUtils
view release on metacpan or search on metacpan
script/coerce-with-sah view on Meta::CPAN
summary => "Show data alongside with coerced result",
description => <<'_',
The default is to show the coerced result only.
_
schema=>['bool', is=>1],
cmdline_aliases => {d=>{}},
tags => ['category:output'],
},
# with_debug => {
# summary => 'Generate coercer with debug on',
# description => <<'_',
#
#This means e.g. to pepper the coercer code with logging statements.
#
#_
# schema => ['bool', is=>1],
# tags => ['category:coercer-specification'],
# },
# pp => {
# summary => 'Generate coercer code that avoids the use of XS modules',
# schema => ['bool', is=>1],
# tags => ['category:coercer-specification'],
# # XXX only relevant when compiler=perl
# },
# core => {
# summary => 'Generate Perl coercer code that avoids the use of non-core modules',
# schema => ['bool', is=>1],
# tags => ['category:coercer-specification'],
# # XXX only relevant when compiler=perl
# },
# core_or_pp => {
# summary => 'Generate Perl coercer code that only uses core or pure-perl modules',
# schema => ['bool', is=>1],
# tags => ['category:coercer-specification'],
# # XXX only relevant when compiler=perl
# },
# no_modules => {
# summary => 'Generate Perl coercer code that does not use modules',
# schema => ['bool', is=>1],
# tags => ['category:coercer-specification'],
# # XXX only relevant when compiler=perl
# },
compiler => {
summary => "Select compiler",
schema=>['str*', in=>[qw/perl js/]],
default => 'perl',
cmdline_aliases => {C=>{}},
tags => ['category:coercer-specification'],
},
linenum => {
summary => 'When showing source code, add line numbers',
schema=>['bool', is=>1],
cmdline_aliases => {l=>{}},
tags => ['category:output'],
},
},
examples => [
{
src => q([[prog]] date --coerce-to DateTime --data-as-perl '"2016-05-22"'),
src_plang => 'bash',
},
{
summary => 'Coerce multiple data',
src => q([[prog]] date --coerce-to 'float(epoch)' --multiple-data-as-perl '["2016-05-15", "1463328281"]'),
src_plang => 'bash',
},
{
summary => 'Add one or more coerce rules',
src => q([[prog]] duration --coerce-rule From_str::human --coerce-rule From_str::iso8601 --data-as-perl '"P1Y2M"'),
src_plang => 'bash',
},
{
summary => 'Show source code',
src => q([[prog]] duration --coerce-to 'float(secs)' -c),
src_plang => 'bash',
},
{
summary => 'Show source code, with line number',
src => q([[prog]] duration --coerce-to 'DateTime::Duration' -c -l),
src_plang => 'bash',
},
{
summary => 'Show source code (JavaScript)',
src => q([[prog]] date -C js -c),
src_plang => 'bash',
},
],
};
sub coerce_with_sah {
my %args = @_;
my $c = $args{compiler};
my $res;
GET_RESULT:
{
if ($args{show_rules}) {
require Data::Sah::CoerceCommon;
my $rules = Data::Sah::CoerceCommon::get_coerce_rules(
type => $args{type},
compiler => $c,
(coerce_to => $args{coerce_to}) x !!defined($args{coerce_to}),
(coerce_rules => $args{coerce_rules}) x !!defined($args{coerce_rules}),
data_term => ($c eq 'perl' ? '$data' : 'data'),
);
$res = [200, "OK", $rules];
last GET_RESULT;
}
my $gen_res;
{
no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
my %gen_args = (
type => $args{type},
return_type => $args{return_type},
(coerce_to => $args{coerce_to}) x !!defined($args{coerce_to}),
(coerce_rules => $args{coerce_rules}) x !!defined($args{coerce_rules}),
);
$gen_args{source} = 1 if $args{show_code};
#$gen_opts{debug} = 1 if $args{with_debug};
#$gen_opts{pp} = 1 if $args{pp};
#$gen_opts{core} = 1 if $args{core};
#$gen_opts{core_or_pp} = 1 if $args{core_or_pp};
#$gen_opts{no_modules} = 1 if $args{no_modules};
if ($c eq 'perl') {
require Data::Sah::Coerce;
$gen_res = Data::Sah::Coerce::gen_coercer(%gen_args);
} elsif ($c eq 'js') {
require Data::Sah::CoerceJS;
$gen_res = Data::Sah::CoerceJS::gen_coercer(%gen_args);
} else {
$res = [400, "Unknown compiler '$c', please specify perl/js"];
last GET_RESULT;
}
}
if ($args{show_code}) {
$gen_res .= "\n" unless $gen_res =~ /\R\z/;
if ($args{linenum}) {
script/coerce-with-sah view on Meta::CPAN
To disable searching for configuration files, pass C<--no-config>.
You can put multiple profiles in a single file by using section names like C<[profile=SOMENAME]> or C<[SOMESECTION profile=SOMENAME]>. Those sections will only be read if you specify the matching C<--config-profile SOMENAME>.
You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program match...
You can also filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...
To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:
[plugin=DumpArgs]
-event=before_validate_args
-prio=99
[plugin=Foo]
-event=after_validate_args
arg1=val1
arg2=val2
which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.
List of available configuration parameters:
coerce_rules (see --coerce-rule)
coerce_to (see --coerce-to)
compiler (see --compiler)
data_as_json (see --data-as-json)
data_as_perl (see --data-as-perl)
data_with_result (see --data-with-result)
format (see --format)
linenum (see --linenum)
multiple_data_as_json (see --multiple-data-as-json)
multiple_data_as_perl (see --multiple-data-as-perl)
naked_res (see --naked-res)
return_type (see --return-type)
show_code (see --show-code)
show_rules (see --show-rules)
type (see --type)
=head1 ENVIRONMENT
=head2 COERCE_WITH_SAH_OPT
String. Specify additional command-line options.
=head1 FILES
=head2 /home/u1/.config/coerce-with-sah.conf
=head2 /home/u1/coerce-with-sah.conf
=head2 /etc/coerce-with-sah.conf
=head1 EXAMPLES
=head2 Example #1
% coerce-with-sah date --coerce-to DateTime --data-as-perl '"2016-05-22"'
do {
my $a = bless({
formatter => undef,
local_c => {
day => 22,
day_of_quarter => 52,
day_of_week => 7,
day_of_year => 143,
hour => 0,
minute => 0,
month => 5,
quarter => 2,
second => 0,
year => 2016,
},
local_rd_days => 736106,
local_rd_secs => 0,
locale => bless({
am_pm_abbreviated => ["AM", "PM"],
available_formats => {
"Bh" => "h B",
"Bhm" => "h:mm B",
"Bhms" => "h:mm:ss B",
"d" => "d",
"E" => "ccc",
"EBhm" => "E h:mm B",
"EBhms" => "E h:mm:ss B",
"Ed" => "d E",
"EHm" => "E HH:mm",
"Ehm" => "E h:mm\x{202F}a",
"Ehm-alt-ascii" => "E h:mm a",
"Ehms" => "E h:mm:ss\x{202F}a",
"EHms" => "E HH:mm:ss",
"Ehms-alt-ascii" => "E h:mm:ss a",
"Gy" => "y G",
"GyMd" => "M/d/y G",
"GyMMM" => "MMM y G",
"GyMMMd" => "MMM d, y G",
"GyMMMEd" => "E, MMM d, y G",
"H" => "HH",
"h" => "h\x{202F}a",
"h-alt-ascii" => "h a",
"Hm" => "HH:mm",
"hm" => "h:mm\x{202F}a",
"hm-alt-ascii" => "h:mm a",
"hms" => "h:mm:ss\x{202F}a",
"Hms" => "HH:mm:ss",
"hms-alt-ascii" => "h:mm:ss a",
"Hmsv" => "HH:mm:ss v",
"hmsv" => "h:mm:ss\x{202F}a v",
"hmsv-alt-ascii" => "h:mm:ss a v",
"Hmv" => "HH:mm v",
"hmv" => "h:mm\x{202F}a v",
"hmv-alt-ascii" => "h:mm a v",
"M" => "L",
"Md" => "M/d",
"MEd" => "E, M/d",
"MMM" => "LLL",
"MMMd" => "MMM d",
"MMMEd" => "E, MMM d",
script/coerce-with-sah view on Meta::CPAN
"January",
"February",
"March",
"April",
"May",
"June",
"July",
"August",
"September",
"October",
"November",
"December",
],
name => "English United States",
native_language => "English",
native_name => "English United States",
native_script => undef,
native_territory => "United States",
native_variant => undef,
quarter_format_abbreviated => ["Q1" .. "Q4"],
quarter_format_narrow => [1 .. 4],
quarter_format_wide => ["1st quarter", "2nd quarter", "3rd quarter", "4th quarter"],
quarter_stand_alone_abbreviated => ["Q1" .. "Q4"],
quarter_stand_alone_narrow => [1 .. 4],
quarter_stand_alone_wide => ["1st quarter", "2nd quarter", "3rd quarter", "4th quarter"],
script => undef,
territory => "United States",
time_format_full => "h:mm:ss\x{202F}a zzzz",
time_format_long => "h:mm:ss\x{202F}a z",
time_format_medium => "h:mm:ss\x{202F}a",
time_format_short => "h:mm\x{202F}a",
variant => undef,
version => 44,
},
month_format_abbreviated => 'fix',
month_format_narrow => 'fix',
month_format_wide => 'fix',
month_stand_alone_abbreviated => 'fix',
month_stand_alone_narrow => 'fix',
month_stand_alone_wide => 'fix',
name => "English United States",
native_language => "English",
native_name => "English United States",
native_script => undef,
native_territory => "United States",
native_variant => undef,
quarter_format_abbreviated => 'fix',
quarter_format_narrow => 'fix',
quarter_format_wide => 'fix',
quarter_stand_alone_abbreviated => 'fix',
quarter_stand_alone_narrow => 'fix',
quarter_stand_alone_wide => 'fix',
script => undef,
territory => "United States",
time_format_full => "h:mm:ss\x{202F}a zzzz",
time_format_long => "h:mm:ss\x{202F}a z",
time_format_medium => "h:mm:ss\x{202F}a",
time_format_short => "h:mm\x{202F}a",
variant => undef,
version => 44,
}, "DateTime::Locale::FromData"),
offset_modifier => 0,
rd_nanosecs => 0,
tz => bless({
is_olson => 1,
max_year => 2033,
name => "Asia/Jakarta",
spans => [
["-Inf", 58904383968, "-Inf", 58904409600, 25632, 0, "LMT"],
[
58904383968,
60683964000,
58904409600,
60683989632,
25632,
0,
"BMT",
],
[
60683964000,
60962776800,
60683990400,
60962803200,
26400,
0,
"+0720",
],
[
60962776800,
61259041800,
60962803800,
61259068800,
27000,
0,
"+0730",
],
[
61259041800,
61369628400,
61259074200,
61369660800,
32400,
0,
"+09",
],
[
61369628400,
61451800200,
61369655400,
61451827200,
27000,
0,
"+0730",
],
[
61451800200,
61514870400,
61451829000,
61514899200,
28800,
0,
"+08",
],
[
61514870400,
61946267400,
61514897400,
61946294400,
27000,
0,
"+0730",
],
[61946267400, "Inf", 61946292600, "Inf", 25200, 0, "WIB"],
],
}, "DateTime::TimeZone::Asia::Jakarta"),
utc_rd_days => 736105,
utc_rd_secs => 61200,
utc_year => 2017,
}, "DateTime");
$a->{locale}{locale_data}{am_pm_abbreviated} = $a->{locale}{am_pm_abbreviated};
$a->{locale}{locale_data}{available_formats} = $a->{locale}{available_formats};
$a->{locale}{locale_data}{day_format_abbreviated} = $a->{locale}{day_format_abbreviated};
$a->{locale}{locale_data}{day_format_narrow} = $a->{locale}{day_format_narrow};
$a->{locale}{locale_data}{day_format_wide} = $a->{locale}{day_format_wide};
$a->{locale}{locale_data}{day_stand_alone_abbreviated} = $a->{locale}{day_stand_alone_abbreviated};
$a->{locale}{locale_data}{day_stand_alone_narrow} = $a->{locale}{day_stand_alone_narrow};
$a->{locale}{locale_data}{day_stand_alone_wide} = $a->{locale}{day_stand_alone_wide};
$a->{locale}{locale_data}{era_abbreviated} = $a->{locale}{era_abbreviated};
$a->{locale}{locale_data}{era_narrow} = $a->{locale}{era_narrow};
$a->{locale}{locale_data}{era_wide} = $a->{locale}{era_wide};
$a->{locale}{month_format_abbreviated} = $a->{locale}{locale_data}{month_format_abbreviated};
$a->{locale}{month_format_narrow} = $a->{locale}{locale_data}{month_format_narrow};
$a->{locale}{month_format_wide} = $a->{locale}{locale_data}{month_format_wide};
$a->{locale}{month_stand_alone_abbreviated} = $a->{locale}{locale_data}{month_stand_alone_abbreviated};
$a->{locale}{month_stand_alone_narrow} = $a->{locale}{locale_data}{month_stand_alone_narrow};
$a->{locale}{month_stand_alone_wide} = $a->{locale}{locale_data}{month_stand_alone_wide};
$a->{locale}{quarter_format_abbreviated} = $a->{locale}{locale_data}{quarter_format_abbreviated};
$a->{locale}{quarter_format_narrow} = $a->{locale}{locale_data}{quarter_format_narrow};
$a->{locale}{quarter_format_wide} = $a->{locale}{locale_data}{quarter_format_wide};
$a->{locale}{quarter_stand_alone_abbreviated} = $a->{locale}{locale_data}{quarter_stand_alone_abbreviated};
$a->{locale}{quarter_stand_alone_narrow} = $a->{locale}{locale_data}{quarter_stand_alone_narrow};
$a->{locale}{quarter_stand_alone_wide} = $a->{locale}{locale_data}{quarter_stand_alone_wide};
$a;
}
=head2 Coerce multiple data
% coerce-with-sah date --coerce-to 'float(epoch)' --multiple-data-as-perl '["2016-05-15", "1463328281"]'
[1463245200, 1463328281]
=head2 Add one or more coerce rules
% coerce-with-sah duration --coerce-rule From_str::human --coerce-rule From_str::iso8601 --data-as-perl '"P1Y2M"'
36817200
=head2 Show source code
% coerce-with-sah duration --coerce-to 'float(secs)' -c
require Scalar::Util;
require Time::Duration::Parse::AsHash;
sub {
my $data = shift;
unless (defined $data) {
return undef;
}
do { if ($data =~ /\A([0-9]{1,2}):([0-9]{1,2})(?::([0-9]{1,2})(\.[0-9]{1,9})?)?\z/) { my $res = do { if ($1 > 23) { ["Invalid hour '$1', must be between 0-23"] } elsif ($2 > 59) { ["Invalid minute '$2', must be between 0-59"] } elsif (defined $3...
}
=head2 Show source code, with line number
% coerce-with-sah duration --coerce-to 'DateTime::Duration' -c -l
1|require DateTime::Duration;
2|require Scalar::Util;
3|require Time::Duration::Parse::AsHash;
4|sub {
5| my $data = shift;
6| unless (defined $data) {
7| return undef;
8| }
9| do { if ($data =~ /\A([0-9]{1,2}):([0-9]{1,2})(?::([0-9]{1,2})(\.[0-9]{1,9})?)?\z/) { my $res = do { if ($1 > 23) { ["Invalid hour '$1', must be between 0-23"] } elsif ($2 > 59) { ["Invalid minute '$2', must be between 0-59"] } elsif (defin...
10|}
=head2 Show source code (JavaScript)
% coerce-with-sah date -C js -c
function (data) {
if (data === undefined || data === null) {
return null;
}
return ((typeof(data)=='number' && data >= 100000000 && data <= 2147483648) ? ((new Date(data * 1000))) : (function() { if ((data instanceof Date)) { var _tmp1 = isNaN(data) ? ['Invalid date', data] : [null, data]; if (_tmp1[0]) { return null } ...
}
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/App-SahUtils>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-App-SahUtils>.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 CONTRIBUTING
To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.
Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:
% prove -l
If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
that are considered a bug and can be reported to me.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2024, 2023, 2022, 2020, 2019, 2018, 2017, 2016, 2015 by perlancar <perlancar@cpan.org>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-SahUtils>
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=cut
( run in 1.171 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )