Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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)


In reply to On creating hash whose keys aren't case-sensitive by anazawa

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others browsing the Monastery: (14)
    As of 2015-07-29 09:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (263 votes), past polls