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

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'); # 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

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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?

    What's my password?
    Create A New User
    [erix]: then you might as well send that patch to the DBIC guys :)
    [Corion]: erix: Yeah, I just found that it has no documentation at all on how to circumvent/ eliminate "1+n SELECTs" by building a local hash... I guess I have to make ->has_many do the hash lookup instead of doing the SQL query. But as the problem ...
    [Corion]: ... has only manifested itself so far through the puzzled questions of other bystanders, I won't go deeper at this time. But the DBIx::Class documentation could well do with a document on how to make "it" (that is, ORMs in general) faster ;)
    [Corion]: I find that DBIx::Class, like most ORMs makes things easy until they become performance critical and then makes it horribly hard to change things because the design is highly inflexible if you don't already know about the problems of 1+n :-/

    How do I use this? | Other CB clients
    Other Users?
    Others taking refuge in the Monastery: (7)
    As of 2017-09-25 11:06 GMT
    Find Nodes?
      Voting Booth?
      During the recent solar eclipse, I:

      Results (279 votes). Check out past polls.