App-hr
view release on metacpan or search on metacpan
#workmen workman
#yachtsmen yachtsman
#yeomen yeoman
#/);
#
## Words ending in ves need care, since the ves may become "f" or "fe".
#
## References:
## http://www.macmillandictionary.com/thesaurus-category/british/Irregular-plurals
#
#my %ves = (qw/
# calves calf
# dwarves dwarf
# elves elf
# halves half
# knives knife
# leaves leaf
# lives life
# loaves loaf
# scarves scarf
# sheaves sheaf
# shelves shelf
# wharves wharf
# wives wife
# wolves wolf
#/);
#
## A dictionary of plurals.
#
#my %plural = (
# # Words ending in "us" which are plural, in contrast to words like
# # "citrus" or "bogus".
# 'menus' => 'menu',
# 'buses' => 'bus',
# %ves,
# %irregular,
#);
#
## A store of words which are the same in both singular and plural.
#
#my @no_change = qw/
# deer
# ides
# fish
# means
# offspring
# series
# sheep
# species
# /;
#
#@plural{@no_change} = @no_change;
#
## A store of words which look like plurals but are not.
#
## References:
#
## http://wiki.answers.com/Q/What_are_some_examples_of_singular_nouns_ending_in_S
## http://virtuallinguist.typepad.com/the_virtual_linguist/2009/10/singular-nouns-ending-in-s.html
#
#my @not_plural = (qw/
#Aries
#Charles
#Gonzales
#Hades
#Hercules
#Hermes
#Holmes
#Hughes
#Ives
#Jacques
#James
#Keyes
#Mercedes
#Naples
#Oates
#Raines
#Texas
#athletics
#bogus
#bus
#cactus
#cannabis
#caries
#chaos
#citrus
#clothes
#corps
#corpus
#devious
#dias
#facies
#famous
#hippopotamus
#homunculus
#iris
#lens
#mathematics
#metaphysics
#metropolis
#mews
#minus
#miscellaneous
#molasses
#mrs
#narcissus
#news
#octopus
#ourselves
#papyrus
#perhaps
#physics
#platypus
#plus
#previous
#pus
#rabies
#scabies
#sometimes
#stylus
#themselves
#this
#thus
#various
#yes
#nucleus
#synchronous
#/);
#
#my %not_plural;
#
#@not_plural{@not_plural} = (1) x @not_plural;
#
## A store of words which end in "oe" and whose plural ends in "oes".
#
## References
## http://www.scrabblefinder.com/ends-with/oe/
#
## Also used
#
## perl -n -e 'print if /oe$/' < /usr/share/dict/words
#
#my @oes = (qw/
#canoes
#does
#foes
#gumshoes
#hoes
#horseshoes
#oboes
#shoes
#snowshoes
#throes
#toes
#/);
#
#my %oes;
#
#@oes{@oes} = (1) x @oes;
#
## A store of words which end in "ie" and whose plural ends in "ies".
#
## References:
## http://www.scrabblefinder.com/ends-with/ie/
## (most of the words are invalid, the above list was manually searched
## for useful words).
#
## Also get a good list using
#
## perl -n -e 'print if /ie$/' < /usr/share/dict/words
#
## There are too many obscure words there though.
#
## Also, I'm deliberately not including "Bernie" and "Bessie" since the
## plurals are rare I think.
#
#my @ies = (qw/
#Aussies
#Valkryies
#aunties
#bogies
#brownies
#calories
#charlies
#coolies
#coteries
#curies
#cuties
#dies
#genies
#goalies
#kilocalories
#oeconomi
#oesophagi
#panni
#periÅci
#phocomeli
#phoeti
#platypi
#polypi
#precunei
#radii
#rhombi
#sarcophagi
#solidi
#stimuli
#succubi
#syllabi
#thesauri
#thrombi
#tori
#trophi
#uteri
#viri
#virii
#xiphopagi
#zygomatici
#/);
#
#my %i_to_us;
#@i_to_us{@i_to_us} = (1) x @i_to_us;
#
## -i to -o
#my @i_to_o = (qw/
# alveoli
# ghetti
# manifesti
# ostinati
# pianissimi
# scenarii
# stiletti
# torsi
#/);
#
#my %i_to_o;
#@i_to_o{@i_to_o} = (1) x @i_to_o;
#
## -i to something else
#
#my %i_to_other = (
# improvisatori => 'improvisatore',
# rhinoceri => 'rhinoceros',
# scaloppini => 'scaloppine'
#);
#
## See documentation below.
#
#sub to_singular
#{
# my ($word) = @_;
# # The return value.
# my $singular = $word;
# if (! $not_plural{$word}) {
# # The word is not in the list of exceptions.
# if ($plural{$word}) {
# # The word has an irregular plural, like "children", or
# # "geese", so look up the singular in the table.
# $singular = $plural{$word};
# }
# elsif ($word =~ /s$/) {
# # The word ends in "s".
# if ($word =~ /'s$/) {
# # report's, etc.
# ;
# }
# elsif (length ($word) <= 2) {
# # is, as, letter s, etc.
# ;
# }
# elsif ($word =~ /ss$/) {
# # useless, etc.
# ;
# }
# elsif ($word =~ /sis$/) {
# # basis, dialysis etc.
# ;
# }
# elsif ($word =~ /ies$/) {
# # The word ends in "ies".
# if ($ies{$word}) {
# # Lies -> lie
# $singular =~ s/ies$/ie/;
# }
# else {
# # Fries -> fry
# $singular =~ s/ies$/y/;
# }
# }
# elsif ($word =~ /oes$/) {
# # The word ends in "oes".
# if ($oes{$word}) {
# # Toes -> toe
# $singular =~ s/oes$/oe/;
# }
# else {
# # Potatoes -> potato
# $singular =~ s/oes$/o/;
# }
# }
# elsif ($word =~ /xes$/) {
# # The word ends in "xes".
# $singular =~ s/xes$/x/;
# }
# elsif ($word =~ /ses$/) {
# if ($ses{$word}) {
# $singular =~ s/ses$/se/;
# }
# else {
# $singular =~ s/ses$/s/;
# }
# }
# elsif ($word =~ $es_re) {
# # Sandwiches -> sandwich
# return 1 if $m{bash_joker} && $m{bash_joker} eq '*';
# }
# 0;
#}
#
#sub contains_globstar_wildcard {
# my $str = shift;
#
# while ($str =~ /$RE_WILDCARD_BASH/go) {
# my %m = %+;
# return 1 if $m{bash_joker} && $m{bash_joker} eq '**';
# }
# 0;
#}
#
#sub convert_wildcard_to_sql {
# my $opts = ref $_[0] eq 'HASH' ? shift : {};
# my $str = shift;
#
# my @res;
# my $p;
# while ($str =~ /$RE_WILDCARD_BASH/g) {
# my %m = %+;
# if (defined($p = $m{bash_brace_content})) {
# die "Cannot convert brace pattern '$p' to SQL";
# } elsif ($p = $m{bash_joker}) {
# if ($m{bash_joker} eq '*' || $m{bash_joker} eq '**') {
# push @res, "%";
# } else {
# push @res, "_";
# }
# } elsif ($p = $m{sql_joker}) {
# push @res, "\\$p";
# } elsif (defined($p = $m{literal_brace_single_element})) {
# die "Currently cannot convert brace literal '$p' to SQL";
# } elsif (defined($p = $m{bash_class})) {
# die "Currently cannot convert class pattern '$p' to SQL";
# } elsif (defined($p = $m{literal})) {
# push @res, $p;
# }
# }
#
# join "", @res;
#}
#
#sub convert_wildcard_to_re {
# my $opts = ref $_[0] eq 'HASH' ? shift : {};
# my $str = shift;
#
# my $opt_brace = $opts->{brace} // 1;
# my $opt_dotglob = $opts->{dotglob} // 0;
# my $opt_globstar = $opts->{globstar} // 0;
# my $opt_ps = $opts->{path_separator} // '/';
#
# die "Please use a single character for path_separator" unless length($opt_ps) == 1;
# my $q_ps =
# $opt_ps eq '-' ? "\\-" :
# $opt_ps eq '/' ? '/' :
# quotemeta($opt_ps);
#
# my $re_not_ps = "[^$q_ps]";
# my $re_not_dot = "[^.]";
# my $re_not_dot_or_ps = "[^.$q_ps]";
#
# my @res;
# my $p;
# my $after_pathsep;
# while ($str =~ /$RE_WILDCARD_BASH/g) {
# my %m = %+;
# if (defined($p = $m{bash_brace_content})) {
# push @res, quotemeta($m{slashes_before_bash_brace}) if
# $m{slashes_before_bash_brace};
# if ($opt_brace) {
# my @elems;
# while ($p =~ /($re_bash_brace_element)(,|\z)/g) {
# push @elems, $1;
# last unless $2;
# }
# #use DD; dd \@elems;
# push @res, "(?:", join("|", map {
# convert_wildcard_to_re({
# brace => 0,
# dotglob => $opt_dotglob,
# globstar => $opt_globstar,
# }, $_)} @elems), ")";
# } else {
# push @res, quotemeta($m{bash_brace});
# }
#
# } elsif (defined($p = $m{bash_joker})) {
# if ($p eq '?') {
# push @res, '.';
# } elsif ($p eq '*' || $p eq '**' && !$opt_globstar) {
# push @res, $opt_dotglob || (@res && !$after_pathsep) ?
# "$re_not_ps*" : "$re_not_dot_or_ps$re_not_ps*";
# } elsif ($p eq '**') { # and with 'globstar' option set
# if ($opt_dotglob) {
# push @res, '.*';
# } elsif (@res && !$after_pathsep) {
# push @res, "(?:$re_not_ps*)(?:$q_ps+$re_not_dot_or_ps$re_not_ps*)*";
# } else {
# push @res, "(?:$re_not_dot_or_ps$re_not_ps*)(?:$q_ps+$re_not_dot_or_ps$re_not_ps*)*";
# }
# }
#
# } elsif (defined($p = $m{literal_brace_single_element})) {
# push @res, quotemeta($p);
# } elsif (defined($p = $m{bash_class})) {
# # XXX no need to escape some characters?
# push @res, $p;
# } elsif (defined($p = $m{sql_joker})) {
# push @res, quotemeta($p);
# } elsif (defined($p = $m{literal})) {
# push @res, quotemeta($p);
# }
#
# $after_pathsep = defined($m{literal}) && substr($m{literal}, -1) eq $opt_ps;
# }
#
# join "", @res;
#}
#
#1;
## ABSTRACT: Bash wildcard string routines
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#String::Wildcard::Bash - Bash wildcard string routines
#
#=head1 VERSION
#
#This document describes version 0.045 of String::Wildcard::Bash (from Perl distribution String-Wildcard-Bash), released on 2022-08-12.
#
#=head1 SYNOPSIS
#
# use String::Wildcard::Bash qw(
# $RE_WILDCARD_BASH
#
# contains_wildcard
# contains_brace_wildcard
# contains_class_wildcard
# contains_joker_wildcard
# contains_qmark_wildcard
# contains_glob_wildcard
# contains_globstar_wildcard
#
# convert_wildcard_to_sql
# convert_wildcard_to_re
# );
#
# say 1 if contains_wildcard("")); # ->
# say 1 if contains_wildcard("ab*")); # -> 1
# say 1 if contains_wildcard("ab\\*")); # ->
#
# say 1 if contains_glob_wildcard("ab*")); # -> 1
# say 1 if contains_glob_wildcard("ab?")); # ->
( run in 0.782 second using v1.01-cache-2.11-cpan-39bf76dae61 )