thanks almut and hipowls. here is the codes. the Format.pm is too long and i have only posted the part that was related to the line 265. while the IniFiles.pm is the complete code.
/usr/opt/perl5/lib/5.8.2/aix-thread-multi/Time/Format.pm
package 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";
}
/NYSDOT/Config/IniFiles.pm
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;
|