App-PickRandomLines
view release on metacpan or search on metacpan
script/pick-random-lines view on Meta::CPAN
# my $double_quoted;
# my $single_quoted;
#
# for my $char (split //, $str) {
# if ($escaped) {
# $buf .= $char;
# $escaped = undef;
# next;
# }
#
# if ($char eq '\\') {
# if ($single_quoted) {
# $buf .= $char;
# }
# else {
# $escaped = 1;
# }
# next;
# }
#
# if ($char =~ /\s/) {
# if ($single_quoted || $double_quoted) {
# $buf .= $char;
# }
# else {
# push @argv, $buf if defined $buf;
# undef $buf;
# }
# next;
# }
#
# if ($char eq '"') {
# if ($single_quoted) {
# $buf .= $char;
# next;
# }
# $double_quoted = !$double_quoted;
# next;
# }
#
# if ($char eq "'") {
# if ($double_quoted) {
# $buf .= $char;
# next;
# }
# $single_quoted = !$single_quoted;
# next;
# }
#
# $buf .= $char;
# }
# push @argv, $buf if defined $buf;
#
# if ($escaped || $single_quoted || $double_quoted) {
# return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
# }
#
# \@argv;
#}
#
## return ($err, $res, $decoded_val)
#sub _parse_raw_value {
# my ($self, $val, $needs_res) = @_;
#
# if ($val =~ /\A!/ && $self->{enable_encoding}) {
#
# $val =~ s/!(\w+)(\s+)// or return ("Invalid syntax in encoded value");
# my ($enc, $ws1) = ($1, $2);
#
# my $res; $res = [
# "!$enc", # COL_V_ENCODING
# $ws1, # COL_V_WS1
# $1, # COL_V_VALUE
# $2, # COL_V_WS2
# $3, # COL_V_COMMENT_CHAR
# $4, # COL_V_COMMENT
# ] if $needs_res;
#
# # canonicalize shorthands
# $enc = "json" if $enc eq 'j';
# $enc = "hex" if $enc eq 'h';
# $enc = "expr" if $enc eq 'e';
#
# if ($self->{allow_encodings}) {
# return ("Encoding '$enc' is not in ".
# "allow_encodings list")
# unless grep {$_ eq $enc} @{$self->{allow_encodings}};
# }
# if ($self->{disallow_encodings}) {
# return ("Encoding '$enc' is in ".
# "disallow_encodings list")
# if grep {$_ eq $enc} @{$self->{disallow_encodings}};
# }
#
# if ($enc eq 'json') {
#
# # XXX imperfect regex for simplicity, comment should not contain
# # "]", '"', or '}' or it will be gobbled up as value by greedy regex
# # quantifier
# $val =~ /\A
# (".*"|\[.*\]|\{.*\}|\S+)
# (\s*)
# (?: ([;#])(.*) )?
# \z/x or return ("Invalid syntax in JSON-encoded value");
# my $decode_res = $self->_decode_json($val);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($enc eq 'path' || $enc eq 'paths') {
#
# my $decode_res = $self->_decode_path_or_paths($val, $enc);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($enc eq 'hex') {
#
# $val =~ /\A
# ([0-9A-Fa-f]*)
# (\s*)
# (?: ([;#])(.*) )?
# \z/x or return ("Invalid syntax in hex-encoded value");
script/pick-random-lines view on Meta::CPAN
# } elsif ($directive eq 'merge') {
# $self->{_merge} = @$args ? $args : undef;
# } elsif ($directive eq 'noop') {
# } else {
# if ($self->{ignore_unknown_directive}) {
# # assume a regular comment
# next LINE;
# } else {
# $self->_err("Unknown directive '$directive'");
# }
# }
# next LINE;
# }
#
# # comment line
# if ($line =~ /^\s*[;#]/) {
#
# if ($cb) {
# $cb->(
# event => 'comment',
# linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
# );
# }
#
# next LINE;
# }
#
# # section line
# if ($line =~ /^\s*\[\s*(.+?)\s*\](?: \s*[;#].*)?/) {
# my $prev_section = $self->{_cur_section};
# $self->{_cur_section} = $cur_section = $1;
# $res->{$cur_section} //= {};
# $self->{_num_seen_section_lines}++;
#
# # previous section exists? do merging for previous section
# if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
# $self->_merge($prev_section);
# }
#
# if ($cb) {
# $cb->(
# event => 'section',
# linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
# section => $cur_section,
# );
# }
#
# next LINE;
# }
#
# # key line
# if ($line =~ /^\s*([^=]+?)\s*=(\s*)(.*)/) {
# my $key = $1;
# my $space = $2;
# my $val = $3;
#
# if ($self->{warn_perl} && !$space && $val =~ /\A>/) {
# $self->_warn("Probably using Perl syntax instead of INI: $line");
# }
#
# # the common case is that value are not decoded or
# # quoted/bracketed/braced, so we avoid calling _parse_raw_value here
# # to avoid overhead
# if ($val =~ /\A["!\\[\{~]/) {
# $_raw_val = $val if $cb;
# my ($err, $parse_res, $decoded_val) = $self->_parse_raw_value($val);
# $self->_err("Invalid value: " . $err) if $err;
# $val = $decoded_val;
# } else {
# $_raw_val = $val if $cb;
# $val =~ s/\s*[#;].*//; # strip comment
# }
#
# if (exists $res->{$cur_section}{$key}) {
# if (!$self->{allow_duplicate_key}) {
# $self->_err("Duplicate key: $key (section $cur_section)");
# } elsif ($self->{_arrayified}{$cur_section}{$key}++) {
# push @{ $res->{$cur_section}{$key} }, $val;
# } else {
# $res->{$cur_section}{$key} = [
# $res->{$cur_section}{$key}, $val];
# }
# } else {
# $res->{$cur_section}{$key} = $val;
# }
#
# if ($cb) {
# $cb->(
# event => 'key',
# linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
# key => $key,
# val => $val,
# raw_val => $_raw_val,
# );
# }
#
# next LINE;
# }
#
# $self->_err("Invalid syntax");
# }
#
# if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
# $self->_merge($cur_section);
# }
#
# $res;
#}
#
#1;
## ABSTRACT: Read IOD/INI configuration files
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Config::IOD::Reader - Read IOD/INI configuration files
#
#=head1 VERSION
#
#This document describes version 0.345 of Config::IOD::Reader (from Perl distribution Config-IOD-Reader), released on 2022-05-02.
#
#=head1 SYNOPSIS
#
script/pick-random-lines view on Meta::CPAN
#
#If set to true, will not die if an unknown directive is encountered. It will
#simply be ignored as a regular comment.
#
#B<NOTE: Turning this setting on violates IOD specification.>
#
#=head2 warn_perl => bool (default: 0)
#
#Emit warning if configuration contains key line like these:
#
# foo=>"bar"
# foo => 123,
#
#which suggest user is assuming configuration is in Perl format instead of INI.
#
#If you enable this option, but happens to have a value that begins with ">", to
#avoid this warning you can quote the value first:
#
# foo=">the value does begins with a greater-than sign"
# bar=">the value does begins with a greater-than sign and ends with a comma,"
#
#=head1 METHODS
#
#=head2 new(%attrs) => obj
#
#=head2 $reader->read_file($filename[ , $callback ]) => hash
#
#Read IOD configuration from a file. Die on errors.
#
#See C<read_string> for more information on C<$callback> argument.
#
#=head2 $reader->read_string($str[ , $callback ]) => hash
#
#Read IOD configuration from a string. Die on errors.
#
#C<$callback> is an optional coderef argument that will be called during various
#stages. It can be useful if you want more information (especially ordering). It
#will be called with hash argument C<%args>
#
#=over
#
#=item * Found a directive line
#
#Arguments passed: C<event> (str, has the value of 'directive'), C<linum> (int,
#line number, starts from 1), C<line> (str, raw line), C<directive> (str,
#directive name), C<cur_section> (str, current section name), C<args> (array,
#directive arguments).
#
#=item * Found a comment line
#
#Arguments passed: C<event> (str, 'comment'), C<linum>, C<line>, C<cur_section>.
#
#=item * Found a section line
#
#Arguments passed: C<event> (str, 'section'), C<linum>, C<line>, C<cur_section>,
#C<section> (str, section name).
#
#=item * Found a key line
#
#Arguments passed: C<event> (str, 'section'), C<linum>, C<line>, C<cur_section>,
#C<key> (str, key name), C<val> (any, value name, already decoded if encoded),
#C<raw_val> (str, raw value).
#
#=back
#
#TODO: callback when there is merging.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Config-IOD-Reader>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Config-IOD-Reader>.
#
#=head1 SEE ALSO
#
#L<IOD> - specification
#
#L<Config::IOD> - round-trip parser for reading as well as writing IOD documents
#
#L<IOD::Examples> - sample documents
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTOR
#
#=for stopwords Steven Haryanto
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=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>, and sometimes one or two other
#Dist::Zilla plugin and/or Pod::Weaver::Plugin. 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) 2022, 2021, 2019, 2018, 2017, 2016, 2015, 2014 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=Config-IOD-Reader>
#
( run in 2.089 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )