Params::Style - Perl module to allow named parameters in perl_style or javaStyle

Params-Style documentation Contained in the Params-Style distribution.

Index

Code Index:

NAME

Top

Params::Style - Perl module to allow named parameters in perl_style or javaStyle

SYNOPSIS

Top

  use Params::Style;

  my_sub(  FooBar => 1, foo_baz => "bravo");

  sub my_sub
    { my %opt: ParamsStyle = @_;
      print "$opt{foobar} - $opt{foobaz}\n";
    }

or (using a hashref to pass named parameters)

   my_sub(  $toto, $tata, { FooBar => 1, foo_baz => 0 });

  sub my_sub
    { my( $foo, $bar, $opt)= @_;
      my %opt : ParamsStyle( 'JavaStyle')= %$opt;

      print "$opt{FooBar} - $opt{FooBaz}\n";
    }

or (with the functional interface);



  use Params::Style qw( perl_style_params);
  ...
  my_sub( $arg, camelCasedOption => 'fooBar', hideousIMHO => 1, badBADBad => 'foo');
  ...
  sub my_sub
    { my( $arg, @opts)= @_;
      my %opts= perl_style_params( @opts); 
      # %opts is now:
      # camel_case_option => 'fooBar',
      # hideous_IMHO      => 1,
      # bad_BAD_bad       => 'foo'
      ...
    }

ABSTRACT

Top

Params::Style offers functions to convert named parameters from perl_style to javaStyle nad nostyle and vice-versa

DESCRIPTION

Top

Functional Interface

perl_style_params <params>

Converts the keys in <params> into perl_style keys

<params<gt> can be either an array, an array reference or a hash reference

The return value as the same type as <params>:

  my @params= perl_style_params( myArg1 => 1, myArg2 => 1);
  my %params= perl_style_params( myArg1 => 1, myArg2 => 1);
  my $params= perl_style_params( [myArg1 => 1, myArg2 => 1]); # $params is an array reference
  my $params= perl_style_params( {myArg1 => 1, myArg2 => 1}); # $params is a hash reference
javaStyleParams <params>

Converts the keys of <params> into javaStyle keys

JavaStyleParams <params>

Converts the keys of <params> into JavaStyle keys

nostyleparams <params>

Converts the jeys of <params> into nostyle keys

replace_keys <coderef> <params>

Applies <coderef> to the keys in <params>

The following filters are already defined:

JavaStyle

used by JavaStyleParams

javaStyle

used by javaStyleParams

perl_style

used by perl_style_params

nostyle

used by nostyleparams

EXPORT

None by default.

:all

Exports perl_style_params, javaStyleParams, JavaStyleParams, nostyleparams and replace_keys

Autotied hash interface

Instead of calling a function it is also possible to use an autotied hash, in which all the keys will be converted to the proper style:

  sub foo
    { my %params: ParamsStyle( 'perl_style')= @_;
      ...
    }

The extra parameter to tie is either the name of a style (perl_style, nostyle, javaStyle or JavaStyle) or a code reference, that will be applied to all keys to the hash.

By default (if the style is not given) the style will be perstyle.

SEE ALSO

Top

perl

AUTHOR

Top

Michel Rodriguez, <mirod@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2003-2005 by Michel Rodriguez

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Params-Style documentation Contained in the Params-Style distribution. 
package Params::Style;

# $Id: Style.pm,v 1.3 2005/11/29 14:36:10 mrodrigu Exp $

use strict;
use warnings;
use Carp;

require Exporter;

use vars qw( @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION);

@ISA = qw(Exporter);

# This allows declaration use Params::Style ':all';
%EXPORT_TAGS = ( all => [ qw( &perl_style_params &javaStyleParams &JavaStyleParams &nostyleparams &replace_keys) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} },  &replace_keys,
               &perl_style_params, &javaStyleParams, &JavaStyleParams, &nostyleparams
             );

$VERSION = '0.06';


my( $uc, $UC);

BEGIN 
  { if( $] >= 5.007) { $uc  = qr/\p{UppercaseLetter}/;
                       $UC  = qr/\P{UppercaseLetter}/;
                     }
    else             { $uc= qr/[A-Z]/; 
                       $UC= qr/[^A-Z]/;
                     }
  }

################################################################
#                                                              #
#                   functional interface                       #
#                                                              #
################################################################

sub replace_keys
  { my $replace_keys = shift; # sub call to use on each key
    
    if( @_ == 1)
      { # should be a reference
        my $options= shift;
        if( UNIVERSAL::isa( $options, 'ARRAY'))
          { if( scalar @$options % 2) { _croak_odd_arg_nb(); }
            my @options; my $flip= 0;
            foreach (@$options)
              { if( $flip=1-$flip) { push @options, $replace_keys->( $_); }
                else               { push @options, $_;              } 
              }
            return \@options;
          }
        elsif( UNIVERSAL::isa( $options, 'HASH'))
          { my %options= map { $replace_keys->($_) => $options->{$_} } keys %$options;
            return \%options;
          }
        else
          { _croak_wrong_arg_type( ref $options); }
    
          }
    else
      {  if( scalar @_ % 2) { _croak_odd_arg_nb(); }
        my @options;
        while( my $key= shift @_) { push @options, $replace_keys->( $key), shift( @_); }
        return @options;
      }
  }

sub perl_style_params { return replace_keys( \&perl_style, @_); }
sub javaStyleParams   { return replace_keys( \&javaStyle,  @_); }
sub JavaStyleParams   { return replace_keys( \&JavaStyle,  @_); }
sub nostyleparams     { return replace_keys( \&nostyle,    @_); }


################################################################
#                                                              #
#                   basic replace style                        #
#                                                              #
################################################################

sub javaStyle { my $name= shift;    $name=~ s{_(\w)}{\U$1}g;       return $name; }
sub JavaStyle { my $name= shift;    $name=~ s{(?:_|^)(\w)}{\U$1}g; return $name; }
sub nostyle   { my $name= lc shift; $name=~ s{_}{}g;               return $name; }

sub perl_style
  { my $name= shift;
    return $name if( $name=~ m{_});
    $name=~ s{(?<!_)($uc)($UC)}{_\L$1$2}g;
    $name=~ s{(?<!_|$uc)($uc+)}{_$1}g;
    $name=~ s{_($uc)$}{_\L$1};
    $name=~ s{^_}{};
    return $name;
  }
    
sub _croak_odd_arg_nb
  { my $pn_sub= (caller(2))[3];
    my ($package, $filename, $line)= (caller(3))[0..2];
    $filename||= ''; $line ||= '';
    die "odd number of arguments passed to $pn_sub at $filename line $line\n";
  }
  
sub _croak_wrong_arg_type
  { my $type= shift;
    my $pn_sub= (caller(2))[3];
    my ($package, $filename, $line)= (caller(3))[0..2];
    $filename||= ''; $line ||= '';
    die "wrong arguments type $type passed to $pn_sub at $filename line $line ",
         "should be hash, hashref, array or array ref\n";
  }
  
################################################################
#                                                              #
#                   tied hash interface                        #
#                                                              #
################################################################

use Attribute::Handlers autotie => { '__CALLER__::ParamsStyle' => __PACKAGE__ };

use vars qw(@ISA);
use Tie::Hash;
unshift @ISA, 'Tie::ExtraHash';

my %replace_func= ( perl_style => \&Params::Style::perl_style,
                    javaStyle  => \&Params::Style::javaStyle,
                    JavaStyle  => \&Params::Style::JavaStyle,
                    nostyle    => \&Params::Style::nostyle,
                  );
my $DEFAULT_STYLE= 'perl_style';


sub TIEHASH
  { my( $class, $style)= @_;
    my $replace_keys;
    if( UNIVERSAL::isa( $style, 'CODE'))
      { $replace_keys= $style; }
    elsif( $style)
      { $replace_keys= $replace_func{$style} or croak "wrong Params::Style style '$style'\n"; } 
    else
      { $replace_keys= $replace_func{$DEFAULT_STYLE}; }
      
    return bless [ {}, $replace_keys ], $class;
  }


sub STORE
  { my( $hash, $key, $value)= @_;
    my( $storage, $replace_keys)= @$hash;
    $storage->{$replace_keys->($key)}= $value;
  }

sub EXISTS
  { my( $hash, $key)= @_;
    my( $storage, $replace_keys)= @$hash;
    return exists $storage->{$replace_keys->($key)};
  }

sub FETCH
  { my( $hash, $key)= @_;
    my( $storage, $replace_keys)= @$hash;
    return $storage->{$replace_keys->($key)};
  }



1;
__END__