2 package Compress::Zlib::ParseParameters ;
9 our ($VERSION, @ISA, @EXPORT);
10 $VERSION = '2.000_05';
13 use constant Parse_any => 0x01;
14 use constant Parse_unsigned => 0x02;
15 use constant Parse_signed => 0x04;
16 use constant Parse_boolean => 0x08;
17 use constant Parse_string => 0x10;
18 use constant Parse_custom => 0x12;
20 use constant Parse_store_ref => 0x100 ;
22 use constant OFF_PARSED => 0 ;
23 use constant OFF_TYPE => 1 ;
24 use constant OFF_DEFAULT => 2 ;
25 use constant OFF_FIXED => 3 ;
27 push @EXPORT, qw( ParseParameters
28 Parse_any Parse_unsigned Parse_signed
29 Parse_boolean Parse_custom Parse_string
35 my $level = shift || 0 ;
37 my $sub = (caller($level + 1))[3] ;
38 local $Carp::CarpLevel = 1 ;
39 my $p = new Compress::Zlib::ParseParameters() ;
41 or croak "$sub: $p->{Error}" ;
49 my $obj = { Error => '',
53 #return bless $obj, ref($class) || $class || __PACKAGE__ ;
61 my $retval = @_ ? shift : undef ;
63 $self->{Error} = $error ;
70 # return $self->{Error} ;
82 # Allow the options to be passed as a hash reference or
83 # as the complete hash.
89 return $self->setError("Expected even number of parameters, got 1")
90 if ! defined $href or ! ref $href or ref $href ne "HASH" ;
92 foreach my $key (keys %$href) {
94 push @entered, \$href->{$key} ;
99 return $self->setError("Expected even number of parameters, got $count")
102 for my $i (0.. $count / 2 - 1) {
103 push @entered, $_[2* $i] ;
104 push @entered, \$_[2* $i+1] ;
110 while (my ($key, $v) = each %$default)
112 my ($type, $value) = @$v ;
114 $self->_checkType($key, \$value, $type, 0, \$x)
116 $got{lc $key} = [0, $type, $value, $x] ;
119 for my $i (0.. @entered / 2 - 1) {
120 my $key = $entered[2* $i] ;
121 my $value = $entered[2* $i+1] ;
123 #print "Key [$key] Value [$value]" ;
124 #print defined $$value ? "[$$value]\n" : "[undef]\n";
130 my $type = $got{lc $key}[OFF_TYPE] ;
132 $self->_checkType($key, $value, $type, 1, \$s)
134 #$value = $$value unless $type & Parse_store_ref ;
136 $got{lc $key} = [1, $type, $value, $s] ;
139 { push (@Bad, $key) }
143 my ($bad) = join(", ", @Bad) ;
144 return $self->setError("unknown key value(s) @Bad") ;
147 $self->{Got} = { %got } ;
159 my $validate = shift ;
162 #local $Carp::CarpLevel = $level ;
163 #print "PARSE $type $key $value $validate $sub\n" ;
164 if ( $type & Parse_store_ref)
167 # if ref ${ $value } ;
175 if ($type & Parse_any)
180 elsif ($type & Parse_unsigned)
182 return $self->setError("Parameter '$key' must be an unsigned int, got undef")
183 if $validate && ! defined $value ;
184 return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
185 if $validate && $value !~ /^\d+$/;
187 $$output = defined $value ? $value : 0 ;
190 elsif ($type & Parse_signed)
192 return $self->setError("Parameter '$key' must be a signed int, got undef")
193 if $validate && ! defined $value ;
194 return $self->setError("Parameter '$key' must be a signed int, got '$value'")
195 if $validate && $value !~ /^-?\d+$/;
197 $$output = defined $value ? $value : 0 ;
200 elsif ($type & Parse_boolean)
202 $$output = defined $value ? $value != 0 : 0 ;
205 elsif ($type & Parse_string)
207 $$output = defined $value ? $value : "" ;
222 return $self->{Got}{lc $name}[OFF_PARSED] ;
232 $self->{Got}{lc $name}[OFF_PARSED] = 1;
233 $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ;
234 $self->{Got}{lc $name}[OFF_FIXED] = $_[0] ;
237 return $self->{Got}{lc $name}[OFF_FIXED] ;
244 my $default = shift ;
246 my $value = $self->{Got}{lc $name}[OFF_DEFAULT] ;
248 return $value if defined $value ;
257 return defined $self->{Got}{lc $name}[OFF_DEFAULT] ;