http://www.perlmonks.org?node_id=11125842


in reply to Module for sets of strings, ordered, case-insensitive?

I'd probably use a tied array.

#!perl use strict; use warnings; use feature 'say'; use Data::Dumper; BEGIN { package Array::CaseFolded; # Perl 5.16 has 'fc' feature; older Perls can just use 'lc'. use if $] >= 5.016, feature => 'fc'; BEGIN { $] < 5.016 and eval 'sub fc ($) { lc $_[0] }' }; # Copied from Tie::StdArray. # Altered STORE, PUSH, UNSHIFT, and SPLICE. sub TIEARRAY { bless [], $_[0] } sub DESTROY { } sub EXTEND { } sub FETCHSIZE { scalar @{$_[0]} } sub STORESIZE { $#{$_[0]} = $_[1]-1 } sub STORE { $_[0]->[$_[1]] = fc $_[2] } sub FETCH { $_[0]->[$_[1]] } sub CLEAR { @{$_[0]} = () } sub POP { pop( @{$_[0]} ) } sub PUSH { my $o = shift; push( @$o, map fc $_, @_ ) } sub SHIFT { shift( @{$_[0]} ) } sub UNSHIFT { my $o = shift; unshift( @$o, map fc $_, @_ ) } sub EXISTS { exists $_[0]->[$_[1]] } sub DELETE { delete $_[0]->[$_[1]] } sub SPLICE { my $ob = shift; my $sz = $ob->FETCHSIZE; my $off = @_ ? shift : 0; $off += $sz if $off < 0; my $len = @_ ? shift : $sz-$off; return splice( @$ob, $off, $len, map fc($_), @_ ); } # Utility functions sub contains { my ( $arr, $value ) = ( shift, fc shift ); !!grep $value eq $_, @$arr; } sub after { my ( $arr, $value ) = ( shift, fc shift ); my $found = -1; for my $i ( 0 .. $#$arr ) { next unless $arr->[$i] eq $value; $found = $i; last; } $found >= 0 and $found < $#$arr and return $arr->[ $found + 1 +]; return undef; } }; tie my @arr, 'Array::CaseFolded'; @arr = qw( Foo BAR baz ); print Dumper(\@arr); say tied(@arr)->contains( 'Bar' ); say tied(@arr)->after( 'Bar' );

Replies are listed 'Best First'.
Re^2: Module for sets of strings, ordered, case-insensitive?
by cxw (Scribe) on Jan 10, 2021 at 16:21 UTC

    Much appreciated! I am going to use GrandFather's straight-OO approach for my current project, for consistency with the rest of the code base. In other circumstances, this would definitely do the job!

    May I cherry-pick some of these ideas for a CPAN module? I like the fc feature test, for example. If so, standard Perl license OK?

      Sorry for slow reply; only just saw your message. Yes, that's fine.