Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

On creating hash whose keys aren't case-sensitive

by anazawa (Beadle)
on Feb 18, 2012 at 07:43 UTC ( #954718=perlquestion: print w/ replies, xml ) Need Help??
anazawa has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks, I'm working on the following situation:
package main; use CGI qw(header); our $header_ref = { -type => 'text/html' }; # loads plugins print header( $header_ref );
Above script passes a hash reference CGI::header to generate HTTP headers. CGI::header doesn't care whether keys are lowercased or camelized, nor whether to put a dash before a key. And also underscores are translated into dashes. And so the following parameters are semantically equivalent:
$header_ref = { 'content-length' => 1234, 'content_length' => 1234, '-content-length' => 1234, '-content_length' => 1234, 'Content-Length' => 1234, 'Content_Length' => 1234, '-Content-Length' => 1234, '-Content_Length' => 1234, };
Plugin developers can modify $main::header_ref. When they modify HTTP headers, they must write as follows:
# plugins/foo package foo; $main::header_ref->{'-status'} = '304 Not Modified';
Another plugin may be as follows:
# plugins/bar package bar; $main::header_ref->{'Status'} = '404 Not Found';
To solve above problem, I wrote the following module;
# plugins/foo package foo; use Header qw(set_header); set_header( $main::header, 'Status' => '304 Not Modified'); # Header.pm package Header; use Exporter 'import'; use List::Util qw(first); our @EXPORT_OK = qw(get_header set_header exists_header delete_header) +; sub get_header { my $header_ref = shift; my $key = _lc( shift ); if ( wantarray ) { my @keys = grep { _lc( $_ ) eq $key } keys %{ $header_ref }; return @{ $header_ref }{ @keys }; } else { my $first_key = first { _lc( $_ ) eq $key } keys %{ $header_re +f }; return $header_ref->{ $first_key }; } } sub set_header { my $header_ref = shift; my $key = shift; my $value = shift; my @keys = grep { _lc( $_ ) eq _lc( $key ) } keys %{ $header +_ref }; if ( @keys ) { $key = shift @keys; delete @{ $header_ref }{ @keys }; } $header_ref->{ $key } = $value; return; } sub exists_header { my $header_ref = shift; my $key = _lc( shift ); my @keys = grep { _lc( $_ ) eq $key } keys %{ $header_ref }; return scalar @keys; } sub delete_header { my $header_ref = shift; my $key = _lc( shift ); # deletes elements whose key matches $key my @keys = grep { _lc( $_ ) eq $key } keys %{ $header_ref }; delete @{ $header_ref }{ @keys }; return; } # returns a lowercased version of a given string sub _lc { my $key = lc shift; # get rid of an initial dash if exists $key =~ s{^\-}{}; # use dashes instead of underscores $key =~ tr{_}{-}; return $key; }
I don't think that the above way is the best to solve the problem. Although I intended to use Tie::Hash to implement above features, I don't understand how to use this module. I'm waiting for your suggestions or comments.

Update: NOTE: I assumed that I might not modify the main script. (Thanks to tobyinc)

Comment on On creating hash whose keys aren't case-sensitive
Select or Download Code
Re: On creating hash whose keys aren't case-sensitive
by davido (Archbishop) on Feb 18, 2012 at 09:54 UTC

    I haven't personally used the module, but it might be an opportunity to try out Tie::Hash::Regex. Your content-length key could match against a regex like this, for example:

    /^(?i:-?content[_-]length)$/

    From looking over the synopsis, the lookup would be as follows:

    $hash{'^(?i:-?content[_-]length)$'}

    Realistically though, it's probably better to leave hash behavior alone, and just normalize your input before trying to do key lookups.


    Dave

      Thanks for your suggestion. Tie::Hash::Regex interests me. I confirmed your regex passed the following test:
      # tie_hash_regex.t use strict; use Tie::Hash::Regex; use Test::Simple tests => 8; my @keys = qw( content-length content_length -content-length -content_length Content-Length Content_Length -Content-Length -Content_Length ); for my $key ( @keys ) { my %hash; tie %hash, 'Tie::Hash::Regex'; $hash{ $key } = 1234; ok $hash{'^(?i:-?content[_-]length)$'} == 1234; }
Re: On creating hash whose keys aren't case-sensitive
by tobyink (Abbot) on Feb 18, 2012 at 10:56 UTC

    Why not use HTTP::Headers? It's got all the init_header, push_header, remove_header stuff already done.

    You may just need to write a small subclass to add a $header_ref->print_headers method which prints out headers in a format suitable for CGI.

      I welcome your suggestion. Plack::Util::headers is maybe inspired by HTTP::Headers. Maybe not. I assumed that I might not modify the main script. In addition, I love CGI.pm :)

      Has anyone written this subclass or method? This would be VERY helpful as I want to use REST::Client which requires a hashref of the headers.

      I wish HTTP::Headers had this as a built-in!!

      Thanks in advance!!

Re: On creating hash whose keys aren't case-sensitive
by CountZero (Bishop) on Feb 18, 2012 at 12:50 UTC
    Following the maxim of "be strict with your output, but liberal with your input", it is a Best Practice™ to always check, sanitize and normalize your input.

    And just for the fun of it: your _lc rewritten into one regex:

    use Modern::Perl; sub _lc { my $key = shift; my $success = $key =~ s/^-?([^-_]*)[-_]?([^-_]*)$/$2?lc"$1_$2":lc$ +1/e; return $key if $success; } print _lc($_) while (<DATA>); __DATA__ content-length content_length -content-length -content_length Content-Length Content_Length -Content-Length -Content_Length changed Changed -changed -Changed Too-many_dashes-Or-underscores
    This sub returns undef (indicating an error) if you give it a string with more than one internal dash or underscore.

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

    My blog: Imperial Deltronics

      This sub returns undef (indicating an error) if you give it a string with more than one internal dash or underscore.

      Like the Access-Control-Allow-Origin header?

        Absolutely!

        CountZero

        A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

        My blog: Imperial Deltronics
      Thanks for your suggestion. Although I didn't understand why your code worked so, I confirmed your sub worked in an expected way. I didn't consider whether to normalize users' inputs. In my case, "be strict with your output" points out the following:
      # Header.pm sub set_header { $header_ref->{ $key } = $value; }
      "(be) liberal with your input" does the following:
      # plugins/foo set_header( $main::header_ref, '-status' => '304 Not Modified' );
      Your comment meant a lot to me.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://954718]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2014-09-18 09:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (109 votes), past polls