package Perinci::Examples; use 5.010; use strict; use warnings; use List::Util qw(min max); use Log::Any '$log'; our $VERSION = '0.08'; # VERSION our @ISA = qw(Exporter); our @EXPORT_OK = qw( delay dies err randlog gen_array gen_hash noop ); our %SPEC; # package metadata $SPEC{':package'} = { v => 1.1, summary => 'This package contains various examples', }; # variable metadata $SPEC{'$Var1'} = { v => 1.1, summary => 'This variable contains the meaning of life', }; our $Var1 = 42; $SPEC{delay} = { v => 1.1, summary => "Sleep, by default for 10 seconds", description => <<'_', Can be used to test the *time_limit* property. _ args => { n => { summary => 'Number of seconds to sleep', schema => ['int', {default=>10, min=>0, max=>7200}], pos => 0, }, per_second => { summary => 'Whether to sleep(1) for n times instead of sleep(n)', schema => ['bool', {default=>0}], }, }, }; sub delay { my %args = @_; my $n = $args{n} // 10; if ($args{per_second}) { sleep 1 for 1..$n; } else { sleep $n; } [200, "OK", "Slept for $n sec(s)"]; } $SPEC{dies} = { v => 1.1, summary => "Dies tragically", description => <<'_', Can be used to test exception handling. _ args => { }, }; sub dies { my %args = @_; die; } $SPEC{err} = { v => 1.1, summary => "Return error response", description => <<'_', _ args => { code => { summary => 'Error code to return', schema => ['int' => {default => 500}], }, }, }; sub err { my %args = @_; my $code = int($args{code}) // 0; $code = 500 if $code < 100 || $code > 555; [$code, "Response $code"]; } my %str_levels = qw(1 fatal 2 error 3 warn 4 info 5 debug 6 trace); $SPEC{randlog} = { v => 1.1, summary => "Produce some random Log::Any log messages", description => <<'_', _ args => { n => { summary => 'Number of log messages to produce', schema => [int => {default => 10, min => 0, max => 1000}], pos => 0, }, min_level => { summary => 'Minimum level', schema => ['int*' => {default=>1, min=>0, max=>6}], pos => 1, }, max_level => { summary => 'Maximum level', schema => ['int*' => {default=>6, min=>0, max=>6}], pos => 2, }, }, }; sub randlog { my %args = @_; my $n = $args{n} // 10; $n = 1000 if $n > 1000; my $min_level = $args{min_level}; $min_level = 1 if !defined($min_level) || !$str_levels{$min_level}; my $max_level = $args{max_level}; $max_level = 1 if !defined($max_level) || !$str_levels{$max_level}; for my $i (1..$n) { my $num_level = int($min_level + rand()*($max_level-$min_level+1)); my $str_level = $str_levels{$num_level}; $log->$str_level("($i/$n) This is random log message #$i, ". "level=$num_level ($str_level): ". int(rand()*9000+1000)); } [200, "OK"]; } $SPEC{gen_array} = { v => 1.1, summary => "Generate an array of specified length", description => <<'_', _ args => { len => { summary => 'Array length', schema => ['int' => {default=>10, min => 0, max => 1000}], pos => 0, req => 1, }, }, }; sub gen_array { my %args = @_; my $len = int($args{len}); defined($len) or return [400, "Please specify len"]; $len = 1000 if $len > 1000; my $array = []; for (1..$len) { push @$array, int(rand()*$len)+1; } [200, "OK", $array]; } $SPEC{gen_hash} = { v => 1.1, summary => "Generate a hash with specified number of pairs", description => <<'_', _ args => { pairs => { summary => 'Number of pairs', schema => ['int*' => {min => 0, max => 1000}], pos => 0, }, }, }; sub gen_hash { my %args = @_; my $pairs = int($args{pairs}); defined($pairs) or return [400, "Please specify pairs"]; $pairs = 1000 if $pairs > 1000; my $hash = {}; for (1..$pairs) { $hash->{$_} = int(rand()*$pairs)+1; } [200, "OK", $hash]; } $SPEC{noop} = { v => 1.1, summary => "Do nothing, return original argument", description => <<'_', _ args => { arg => { summary => 'Argument', schema => ['any'], pos => 0, }, }, features => {pure => 1}, }; sub noop { my %args = @_; [200, "OK", $args{arg}]; } $SPEC{test_completion} = { v => 1.1, summary => "Do nothing, return nothing", description => <<'_', This function is used to test argument completion. _ args => { i1 => { schema => ['int*' => {min=>1, xmax=>100}], }, i2 => { schema => ['int*' => {min=>1, max=>1000}], }, f1 => { schema => ['int*' => {xmin=>1, xmax=>10}], }, s1 => { schema => [str => { in=>[qw/apple apricot banana grape grapefruit/, "red date", "red grape", "green grape", ], }], }, s2 => { schema => 'str', completion => sub { my %args = @_; my $word = $args{word} // ""; [ map {$word . $_} "a".."z" ], }, }, s3 => { schema => 'str', completion => sub { die }, }, }, features => {pure => 1}, }; sub test_completion { [200, "OK"]; } 1; # ABSTRACT: Example modules containing metadata and various example functions =pod =head1 NAME Perinci::Examples - Example modules containing metadata and various example functions =head1 VERSION version 0.08 =head1 SYNOPSIS use Perinci::Examples qw(delay); delay(); =head1 DESCRIPTION This module and its submodules contain an odd mix of various functions, variables, and other code entities, along with their L<Rinci> metadata. Mostly used for testing Rinci specification and the various L<Perinci> modules. =head1 FUNCTIONS None are exported by default, but they are exportable. =head1 SEE ALSO L<Perinci> =head1 AUTHOR Steven Haryanto <stevenharyanto@gmail.com> =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2012 by Steven Haryanto. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__