/NYSDOT/Config/IniFiles.pmpackage DBI::Format::String; @DBI::Format::String::ISA = qw(DBI::Format::Base); sub header { my($self, $sth, $fh, $sep) = @_; $self->{'fh'} = $self->setup_fh($fh); $self->{'sth'} = $sth; $self->{'data'} = []; $self->{sep} = $sep if defined $sep; my $types = $sth->{'TYPE'}; my @right_justify; my @widths; my $names = $sth->{'NAME'}; my $type; for (my $i = 0; $i < $sth->{'NUM_OF_FIELDS'}; $i++) { $type = $types->[$i]; push(@widths, ($type == DBI::SQL_DATE)? 8 : ($type == DBI::SQL_INTEGER and $sth->{PRECISION}->[$i] > 1 +5 )? 10 : ($type == DBI::SQL_NUMERIC and $sth->{PRECISION}->[$i] > 15 + )? 10 : defined($sth->{PRECISION}->[$i]) ? $sth->{PRECISION}->[$i]: 0); push(@right_justify, ($type == DBI::SQL_NUMERIC() || $type == DBI::SQL_DECIMAL() || $type == DBI::SQL_INTEGER() || $type == DBI::SQL_SMALLINT() || $type == DBI::SQL_FLOAT() || $type == DBI::SQL_REAL() || $type == DBI::SQL_BIGINT() || $type == DBI::SQL_TINYINT())); my $format_names; $format_names .= sprintf("%%-%ds ", $widths[$i]); print $fh (sprintf($format_names, $names->[$i])); } $self->{'widths'} = \@widths; $self->{'right_justify'} = \@right_justify; print $fh "\n"; }
package NYSDOT::Config::IniFiles; use strict; use warnings; use Config::IniFiles; use Time::Format qw/time_format/; our @ISA = ("Config::IniFiles"); our $VERSION = "0.3"; =head1 NYSDOT::Config::IniFiles A thin wrapper around the OO interface of C<Config::IniFiles>. =head1 VERSION 0.3 =head1 COPYRIGHT NYSDOT, 2003 =head1 AUTHOR Will Coleda (LTI) =head1 METHODS =head2 new This constuctor takes the same arguments at that for C<Config::IniFi +les>. (a hash of -name and value pairs). If an argument of C<-interpolate> (with a valid section name as a va +lue) is passed into the constructor, then we look for a section with the same name as the value of that argument. If present, all parameters declared in that section are considered variables. Any occurances of that parameter name surrounded by %'s i +n a value (not in the paramater name itself) are interpolated with the value of that parameter. Additionally, if this section is present, parameters of the form C<%TIME=yyyymmdd%> will automatically be expa +nded. Anything after the C<=> will be passed to C<Time::Format>. For examp +le, C<%TIME=yymm%> will expand to C<0301> in January, 2003. See L<Time:: +Format> for more details. A new instance of a Config::IniFiles object is created in which: these substitutions are made; the section that defined the interpola +tions is removed; the parameters passed to its constructor do not include C<-interpolate>. If the C<-interpolate> is not present in the original (or referred t +o an invalid section), then no substitutions are done. A warning is em +itted in the case of an invalid section. =cut sub new { my $proto = shift; my %args = @_; my $class = ref($proto) || $proto; my $interpolate = 0; if ($args{"-interpolate"}) { $interpolate = $args{"-interpolate"}; } delete $args{"-interpolate"}; my $obj = $class->SUPER::new (%args); if ($interpolate) { if (! $obj->SectionExists($interpolate)) { warn "invalid interpolation section $interpolate specified"; } my %params; foreach my $param ($obj->Parameters($interpolate)) { $params{$param} = $obj->val($interpolate,$param); } $obj->DeleteSection($interpolate); foreach my $section ($obj->Sections()) { foreach my $param ($obj +->Parameters($section)) { my $val = $obj->val($section,$param); # Explicit parameter substitution foreach my $param (keys %params) { $val =~ s/%$param%/$params{$param}/gi; } # Automatic TIME= substitution. $val =~ s/%TIME=([^%]+)%/time_format($1)/gei; $obj->newval($section,$param,$val); } } } # now, rebless into our own class. bless($obj,$class); } =head2 boolean Similar to C<Config::IniFile>'s C<val> method. Takes an optional parameter to indicate the default if not specified. If the specified section and parameter don't exist, undef is returne +d, unless a default is supplied, it which case it is returned. If the value exists, and is one of C<0>, C<FALSE>, C<NO>, C<OFF>, then the function returns true, otherwise false. (NB: the default value passed in, and the return value, are Perlian true/false values, and not Configian.) =cut sub boolean { my $self = shift; my ($section,$parameter,$default) = @_; defined($section) or die "Must specify section"; defined($parameter) or die "Must specify parameter"; my $val = $self->val($section,$parameter); if (defined($val)) { if ($val =~ /^\s*(0|FALSE|NO|OFF)\s*$/i) { return 0; } else { return 1; } } else { return $default; } } =head1 BUGS If you write the config back out to disk, it will overwrite the para +meterized version, replacing it with a snapshot of the config as you were usin +g it. This is not the right thing to do. So, don't do that. If you set an interpolated parameter to have a value that contains t +he name of another parameter surrounded by C<%>'s, multiple expansions +may occur, depending on ordering. =cut 1;
In reply to Re^2: OS upgrade affecting perl causes all codes to abend
by wtolentino
in thread OS upgrade affecting perl causes all codes to abend
by wtolentino
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |