1package Config::IniHash; 2 3use 5.8.0; 4use Carp; 5use strict; 6use warnings;no warnings 'uninitialized'; 7use Symbol; 8use Encode qw(is_utf8); 9 10use Exporter; 11use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); 12@ISA = qw(Exporter); 13@EXPORT = qw(&ReadINI &WriteINI &PrintINI); 14@EXPORT_OK = qw(&ReadINI &WriteINI &PrintINI &AddDefaults &ReadSection); 15$VERSION = '3.01.01'; 16 17if (0) { # for PerlApp/PerlSvc/PerlCtrl/Perl2Exe 18 require 'Hash/WithDefaults.pm'; 19 require 'Hash/Case/Lower.pm'; 20 require 'Hash/Case/Upper.pm'; 21 require 'Hash/Case/Preserve.pm'; 22} 23 24#use vars qw(heredoc systemvars withdefaults forValue); 25$Config::IniHash::case = 'lower'; 26 # upper, preserve, toupper, tolower 27$Config::IniHash::heredoc = 0; 28$Config::IniHash::systemvars = 1; 29$Config::IniHash::withdefaults = 0; 30$Config::IniHash::sectionorder = 0; 31$Config::IniHash::allowmultiple = 0; 32$Config::IniHash::comment = qr/^\s*[#;]/; 33$Config::IniHash::layer = ''; 34 35*Config::IniHash::allow_multiple = \$Config::IniHash::allowmultiple; 36 37sub BREAK () {1} 38 39sub prepareOpt { 40 my $opt = shift(); 41 42 $opt->{case} = $Config::IniHash::case unless exists $opt->{case}; 43 $opt->{case} = $opt->{insensitive} if exists $opt->{insensitive}; # for backwards compatibility 44 $opt->{heredoc} = $Config::IniHash::heredoc unless exists $opt->{heredoc}; 45 $opt->{systemvars} = $Config::IniHash::systemvars unless exists $opt->{systemvars}; 46 $opt->{withdefaults} = $Config::IniHash::withdefaults unless exists $opt->{withdefaults}; 47 $opt->{forValue} = $Config::IniHash::forValue unless exists $opt->{forValue}; 48 $opt->{sectionorder} = $Config::IniHash::sectionorder unless exists $opt->{sectionorder}; 49 $opt->{allowmultiple} = $opt->{allow_multiple} unless exists $opt->{allowmultiple}; 50 $opt->{allowmultiple} = $Config::IniHash::allowmultiple unless exists $opt->{allowmultiple}; 51 $opt->{comment} = $Config::IniHash::comment unless exists $opt->{comment}; 52 $opt->{layer} = $Config::IniHash::layer unless exists $opt->{layer}; 53 $opt->{layer} = ':' . $opt->{layer} if $opt->{layer} and $opt->{layer} !~ /^:/; 54 55 if ($opt->{class}) { 56 delete $opt->{withdefaults}; 57 } else { 58 for ($opt->{case}) { 59 $_ = lc $_; 60 $_ = 'no' unless $_; 61 62 local $Carp::CarpLevel = 1; 63 /^lower/ and do { 64 if ($opt->{sectionorder} and !ref($opt->{sectionorder})) { 65 $opt->{class} = 'Hash::Case::LowerX'; 66 } else { 67 $opt->{class} = 'Hash::Case::Lower'; 68 } 69 undef $opt->{forName}; 70 BREAK} 71 or 72 /^upper/ and do { 73 $opt->{class} = 'Hash::Case::Upper'; 74 undef $opt->{forName}; 75 BREAK} 76 or 77 /^preserve/ and do { 78 $opt->{class} = 'Hash::Case::Preserve'; 79 undef $opt->{forName}; 80 BREAK} 81 or 82 /^toupper/ and do { 83 undef $opt->{class}; 84 $opt->{forName} = 'uc'; 85 BREAK} 86 or 87 /^tolower/ and do { 88 undef $opt->{class}; 89 $opt->{forName} = 'lc'; 90 BREAK} 91 or 92 /^(?:no|sensitive)/ and do { 93 undef $opt->{class}; 94 undef $opt->{forName}; 95 BREAK} 96 or 97 croak "Option 'case' may be set only to:\n\t'lower', 'upper', 'preserve', 'toupper', 'tolower' or 'no'\n"; 98 99 } 100 101 if ($opt->{class} and $opt->{class} ne 'Hash::Case::LowerX') { 102 my $class = $opt->{class}; 103 my $file = $class; 104 $file =~ s{::}{/}g; 105 if (!$INC{$file.'.pm'}) { 106 eval "use $class;\n1" 107 or croak "ERROR autoloading $class : $@"; 108 } 109 } 110 111 if ($opt->{withdefaults} and !$INC{'Hash/WithDefaults.pm'}) { 112 eval "use Hash::WithDefaults;\n1" 113 or croak "ERROR autoloading Hash::WithDefaults : $@"; 114 } 115 } 116 117 if (! $opt->{heredoc}) { 118 $opt->{heredoc} = 0; 119 } elsif (lc($opt->{heredoc}) eq 'perl') { 120 $opt->{heredoc} = 'perl' 121 } else { 122 $opt->{heredoc} = 1; 123 } 124 if (defined $opt->{systemvars} and $opt->{systemvars}) { 125 $opt->{systemvars} = \%ENV unless (ref $opt->{systemvars}); 126 } else { 127 $opt->{systemvars} = 0; 128 } 129 130 if (! ref $opt->{comment}) { 131 $opt->{comment} = qr/^\s*[$opt->{comment}]/; 132 } 133 134 if (ref $opt->{allowmultiple}) { 135 croak "The allowmultiple option must be a true or false scalar or a reference to a hash of arrays, hashes, regexps or comma separated lists of names!" 136 unless ref $opt->{allowmultiple} eq 'HASH'; 137 138 foreach my $section (values %{$opt->{allowmultiple}}) { 139 if (! ref $section) { 140 $section = {map( ($_ => undef), split( /\s*,\s*/, $section))}; 141 } elsif (ref $section eq 'ARRAY') { 142 $section = {map( ($_ => undef), @$section)}; 143 } elsif (ref $section eq 'Regexp') { 144 } elsif (ref $section ne 'HASH') { 145 croak "The allowmultiple option must be a true or false scalar or a reference to a hash of arrays, hashes, regexps or comma separated lists of names!" 146 } 147 } 148 } 149} 150 151sub ReadINI { 152 my $file = shift; 153 my %opt; 154 if (@_ == 1 and ref $_[0]) { 155 %opt = %{$_[0]}; 156 } elsif (@_ % 2 == 0) { 157 %opt = @_; 158 } else { 159 croak("ReadINI expects the filename plus either a reference to a hash of options or a list with even number of items!"); 160 } 161 prepareOpt(\%opt); 162 163 my $hash; 164 if ($opt{hash}) { 165 $hash = $opt{hash}; 166 } else { 167 $hash = {}; 168 tie %$hash, $opt{class} 169 if $opt{class}; 170 } 171 172 my $section = ''; 173 my $IN; 174 if (ref $file) { 175 my $ref = ref $file; 176 if ($ref eq 'SCALAR') { 177 if (is_utf8($$file)) { 178 $opt{layer} .= ':utf8' unless $opt{layer} =~ /\butf-?8\b/i; 179 } 180 open $IN, "<$opt{layer}", $file; # will read from the referenced scalar 181 } elsif ($ref eq 'ARRAY') { 182 my $data = join "\n", map {s/\r?\n/\n/;chomp;$_} @$file; 183 if (is_utf8($data)) { 184 $opt{layer} .= ':utf8' unless $opt{layer} =~ /\butf-?8\b/i; 185 } 186 open $IN, "<$opt{layer}",\$data; # will read from the referenced scalar 187 } elsif ($ref eq 'HASH') { 188 croak "ReadINI cannot accept a HASH reference as it's parameter!"; 189 } else { 190 $IN = $file; #assuming it's a glob or an object that'll know what to do 191 } 192 } else { 193 if ($opt{layer}) { 194 open $IN, "<$opt{layer}", $file or return undef; 195 } else { 196 open $IN, $file or return undef; 197 } 198 my $bom = <$IN>; 199 if ($bom =~ /\r/) { 200 $opt{layer} .= ':crlf'; 201 } 202 if (substr($bom, 0, 3) eq "\xEF\xBB\xBF") { 203 $opt{layer} .= ':utf8'; 204 close $IN; 205 open $IN, "<$opt{layer}", $file or return undef; 206 read $IN, $bom, 1; 207 } elsif (substr($bom, 0, 1) eq "\x{feff}") { 208 seek($IN,2,0); 209 } else { 210 seek($IN,0,0); 211 } 212 } 213 214 my ($lc,$uc) = ( (defined $opt{forName} and $opt{forName} eq 'lc'), (defined $opt{forName} and $opt{forName} eq 'uc')); 215 if ($opt{sectionorder}) { 216 my $arrayref; 217 if (ref $opt{sectionorder}) { 218 $arrayref = $opt{sectionorder} 219 } else { 220 $arrayref = $hash->{'__SECTIONS__'} = []; 221 } 222 if ($opt{case} eq 'lower' or $opt{case} eq 'tolower') { 223 $opt{sectionorder} = sub {push @$arrayref, lc($_[0])} 224 } elsif ($opt{case} eq 'upper' or $opt{case} eq 'toupper') { 225 $opt{sectionorder} = sub {push @$arrayref, uc($_[0])} 226 } else { 227 $opt{sectionorder} = sub {push @$arrayref, $_[0]} 228 } 229 } 230 my $forValue = $opt{forValue}; 231 232 while (<$IN>) { 233 234 $_ =~ $opt{comment} and next; 235 236 if (/^\[(.*)\]/) { 237 $section = $1; 238 $opt{sectionorder}->($section) if $opt{sectionorder}; 239 if ($lc) { $section = lc $section} elsif ($uc) { $section = uc $section }; 240 unless ($hash->{$section}) { 241 my %tmp = (); 242 if ($opt{withdefaults}) { 243 tie %tmp, 'Hash::WithDefaults', $opt{case}; 244 } else { 245 tie %tmp, $opt{class} 246 if $opt{class}; 247 } 248 $hash->{$section} = \%tmp; 249 } 250 next; 251 } 252 253 if (/^([^=]*?)\s*=\s*(.*?)\s*$/) { 254 my ($name,$value) = ($1,$2); 255 if ($opt{heredoc} eq 'perl' and $value =~ /^<<(['"])?(.+)\1\s*$/) { 256 my $type = $1; 257 my $terminator = $2; 258 $value = ''; 259 while (<$IN>) { 260 chomp; 261 last if $_ eq $terminator; 262 $value .= "\n".$_; 263 } 264 croak "Heredoc value for [$section]$name not closed at end of file!" 265 unless defined $_; 266 substr ($value, 0, 1) = ''; 267 268 if ($type eq '') { 269 $value =~ s/%([^%]*)%/exists($opt{systemvars}{$1}) ? $opt{systemvars}{$1} : "%$1%"/eg if $opt{systemvars}; 270 } elsif ($type eq q{"}) { 271 if ($opt{systemvars}) { 272 $value =~ s/%([^%]*)%/$opt{systemvars}{$1}/g; 273 } else { 274 $value =~ s/%([^%]*)%/$ENV{$1}/g; 275 } 276 } 277 278 } elsif ($opt{heredoc} and $value =~ /^<<(.+)\s*$/) { 279 my $terminator = $1; 280 $value = ''; 281 while (<$IN>) { 282 chomp; 283 last if $_ eq $terminator; 284 $value .= "\n".$_; 285 } 286 croak "Heredoc value for [$section]$name not closed at end of file!" 287 unless defined $_; 288 substr ($value, 0, 1) = ''; 289 $value =~ s/%([^%]*)%/exists($opt{systemvars}{$1}) ? $opt{systemvars}{$1} : "%$1%"/eg if $opt{systemvars}; 290 291 } else { 292 $value =~ s/%([^%]*)%/exists($opt{systemvars}{$1}) ? $opt{systemvars}{$1} : "%$1%"/eg if $opt{systemvars}; 293 } 294 295 if ($lc) { $name = lc $name} elsif ($uc) { $name = uc $name }; 296 if ($forValue) { 297 $value = $forValue->($name, $value, $section, $hash); 298 } 299 if (defined $value) { 300 if (!$opt{allowmultiple}) { 301 $hash->{$section}{$name} = $value; # overwrite 302 } elsif (!ref $opt{allowmultiple}) { 303 if (exists $hash->{$section}{$name}) { 304 if (ref $hash->{$section}{$name}) { 305 push @{$hash->{$section}{$name}}, $value; 306 } else { 307 $hash->{$section}{$name} = [ $hash->{$section}{$name}, $value]; # second value 308 } 309 } else { 310 $hash->{$section}{$name} = $value; # set 311 } 312 } else { 313 if (exists $opt{allowmultiple}{$section}{$name} or exists $opt{allowmultiple}{'*'}{$name}) { 314 push @{$hash->{$section}{$name}}, $value; 315 } else { 316 $hash->{$section}{$name} = $value; # set 317 } 318 } 319 } 320 } 321 } 322 close $IN; 323 return $hash; 324} 325 326sub WriteINI { 327 my ($file,$hash) = @_; 328 open my $OUT, ">$file" or return undef; 329 if (exists $hash->{'__SECTIONS__'}) { 330 my $all_have_order = (scalar(@{$hash->{'__SECTIONS__'}}) == scalar(keys %$hash)-1); 331 foreach my $section (@{$hash->{'__SECTIONS__'}}) { 332 print $OUT "[$section]\n"; 333 my $sec; 334 if (exists $hash->{$section}) { 335 my $sec = $hash->{$section}; 336 foreach my $key (sort keys %{$hash->{$section}}) { 337 if ($key =~ /^[#';]/ and ! defined($sec->{$key})) { 338 print $OUT "$key\n"; 339 } elsif ($sec->{$key} =~ /\n/) { 340 print $OUT "$key=<<*END_$key*\n$sec->{$key}\n*END_$key*\n"; 341 } else { 342 print $OUT "$key=$sec->{$key}\n"; 343 } 344 } 345 } else { 346 $all_have_order = 0; 347 } 348 print $OUT "\n"; 349 } 350 if (!$all_have_order) { 351 my %ordered; @ordered{@{$hash->{'__SECTIONS__'}}} = (); 352 foreach my $section (keys %$hash) { 353 next if exists($ordered{$section}) or $section eq '__SECTIONS__'; 354 print $OUT "[$section]\n"; 355 my $sec = $hash->{$section}; 356 foreach my $key (sort keys %{$hash->{$section}}) { 357 if ($key =~ /^[#';]/ and ! defined($sec->{$key})) { 358 print $OUT "$key\n"; 359 } elsif ($sec->{$key} =~ /\n/) { 360 print $OUT "$key=<<*END_$key*\n$sec->{$key}\n*END_$key*\n"; 361 } else { 362 print $OUT "$key=$sec->{$key}\n"; 363 } 364 } 365 print $OUT "\n"; 366 } 367 } 368 } else { 369 foreach my $section (keys %$hash) { 370 print $OUT "[$section]\n"; 371 my $sec = $hash->{$section}; 372 foreach my $key (keys %{$hash->{$section}}) { 373 if ($key =~ /^[#';]/ and ! defined($sec->{$key})) { 374 print $OUT "$key\n"; 375 } elsif ($sec->{$key} =~ /\n/) { 376 print $OUT "$key=<<*END_$key*\n$sec->{$key}\n*END_$key*\n"; 377 } else { 378 print $OUT "$key=$sec->{$key}\n"; 379 } 380 } 381 print $OUT "\n"; 382 } 383 } 384 close $OUT; 385 return 1; 386} 387*PrintINI = \&WriteINI; 388 389sub AddDefaults { 390 my ($ini, $section, $defaults) = @_; 391 392 croak "$section doesn't exist in the hash!" 393 unless exists $ini->{$section}; 394 395 croak "You can call AddDefaults ONLY on hashes created with\n\$Config::IniHash::withdefaults=1 !" 396 unless tied(%{$ini->{$section}}) and tied(%{$ini->{$section}})->isa('Hash::WithDefaults'); 397 398 if (ref $defaults) { 399 croak "The defaults must be a section name or a hash ref!" 400 unless ref $defaults eq 'HASH'; 401 402 tied(%{$ini->{$section}})->AddDefault($defaults); 403 } else { 404 croak "$defaults doesn't exist in the hash!" 405 unless exists $ini->{$defaults}; 406 407 tied(%{$ini->{$section}})->AddDefault($ini->{$defaults}); 408 } 409} 410 411 412sub ReadSection { 413 my $text = shift; 414 my %opt = @_; 415 prepareOpt(\%opt); 416 417 my $hash= {}; 418 if ($opt{withdefaults}) { 419 tie %$hash, 'Hash::WithDefaults', $opt{case}; 420 } else { 421 tie %$hash, $opt{class} 422 if $opt{class}; 423 } 424 425 open my $IN, '<', \$text; 426 427 my ($lc,$uc) = ( $opt{forName} eq 'lc', $opt{forName} eq 'uc'); 428 my $forValue = $opt{forValue}; 429 while (<$IN>) { 430 /^\s*;/ and next; 431 432 if (/^([^=]*?)\s*=\s*(.*?)\s*$/) { 433 my ($name,$value) = ($1,$2); 434 if ($opt{heredoc} and $value =~ /^<<(.+)$/) { 435 my $terminator = $1; 436 $value = ''; 437 while (<$IN>) { 438 chomp; 439 last if $_ eq $terminator; 440 $value .= "\n".$_; 441 } 442 croak "Heredoc value for $name not closed at end of string!" 443 unless defined $_; 444 substr ($value, 0, 1) = ''; 445 } 446 $value =~ s/%(.*?)%/$opt{systemvars}{$1}/g if $opt{systemvars}; 447 if ($lc) { $name = lc $name} elsif ($uc) { $name = uc $name }; 448 if ($forValue) { 449 $value = $forValue->($name, $value, undef, $hash); 450 } 451 $hash->{$name} = $value; 452 } 453 } 454 close $IN; 455 return $hash; 456} 457 458package Hash::Case::LowerX; 459use base 'Hash::Case'; 460 461use strict; 462use Carp; 463 464sub init($) 465{ my ($self, $args) = @_; 466 467 $self->SUPER::native_init($args); 468 469 croak "No options possible for ".__PACKAGE__ 470 if keys %$args; 471 472 $self; 473} 474 475sub FETCH($) { $_[0]->{($_[1] eq '__SECTIONS__' ? $_[1] : lc $_[1])} } 476sub STORE($$) { $_[0]->{($_[1] eq '__SECTIONS__' ? $_[1] : lc $_[1])} = $_[2] } 477sub EXISTS($) { exists $_[0]->{($_[1] eq '__SECTIONS__' ? $_[1] : lc $_[1])} } 478sub DELETE($) { delete $_[0]->{($_[1] eq '__SECTIONS__' ? $_[1] : lc $_[1])} } 479 4801; 481__END__ 482 483=head1 NAME 484 485Config::IniHash - Perl extension for reading and writing INI files 486 487=head1 VERSION 488 489Version 3.00.05 490 491=head1 SYNOPSIS 492 493 use Config::IniHash; 494 $Config = ReadINI 'c:\some\file.ini'; 495 496=head1 DESCRIPTION 497 498This module reads and writes INI files. 499 500=head2 Functions 501 502=head3 ReadINI 503 504 $hashreference = ReadINI ($filename, %options) 505 $hashreference = ReadINI (\$data, %options) 506 $hashreference = ReadINI (\@data, %options) 507 $hashreference = ReadINI ($filehandle, %options) 508 509The returned hash contains a reference to a hash for each section of 510the INI. 511 512 [section] 513 name=value 514 leads to 515 $hash->{section}->{name} = value; 516 517The available options are: 518 519=over 4 520 521=item heredoc 522 523- controls whether the module supports the heredoc syntax : 524 525 name=<<END 526 the 527 many lines 528 long value 529 END 530 othername=value 531 532 0 : heredocs are ignored, $data->{section}{name} will be '<<END' 533 1 : heredocs are supported, $data->{section}{name} will be "the\nmany lines\nlong value" 534 The Perl-lie extensions of name=<<"END" and <<'END' are not supported! 535 'Perl' : heredocs are supported, $data->{section}{name} will be "the\nmany lines\nlong value" 536 The Perl-lie extensions of name=<<"END" and <<'END' are supported. 537 The <<'END' never interpolates %variables%, the "END" always interpolates variables, 538 unlike in other values, the %variables% that are not defined do not stay in the string! 539 540Default: 0 = OFF 541 542 543=item systemvars 544 545- controls whether the (system) variables enclosed in %% are 546interpolated and optionaly contains the values in a hash ref. 547 548 name=%USERNAME% 549 leads to 550 $data->{section}->{name} = "Jenda" 551 552 systemvars = 1 - yes, take values from %ENV 553 systemvars = \%hash - yes, take values from %hash 554 systemvars = 0 - no 555 556=item case 557 558- controls whether the created hash is case insensitive. The possible values are 559 560 sensitive - the hash will be case sensitive 561 tolower - the hash will be case sensitive, all keys are made lowercase 562 toupper - the hash will be case sensitive, all keys are made uppercase 563 preserve - the hash will be case insensitive, the case is preserved (tied) 564 lower - the hash will be case insensitive, all keys are made lowercase (tied) 565 upper - the hash will be case insensitive, all keys are made uppercase (tied) 566 567=item withdefaults 568 569- controls whether the created section hashes support defaults. See L<Hash::WithDefaults>. 570 571=item class 572 573- allows you to specify the class into which to tie the created hashes. This option overwrites 574the "case" and "withdefaults" options! 575 576You may for example use 577 578 class => 'Tie::IxHash', 579 580to store the sections in hashes that remember the insertion order. 581 582=item sectionorder 583 584- if set to a true value then created hash will contain 585 586 $config->{'__SECTIONS__'} = [ 'the', 'names', 'of', 'the', 'sections', 'in', 'the', 587 'order', 'they', 'were', 'specified', 'in', 'the', 'INI file']; 588 589- if set to an array ref, then the list will be stored in that array, and no $config->{'__SECTIONS__'} 590is created. The case of the section names stored in this array is controled by the "case" option even 591in case you specify the "class". 592 593=item allowmultiple 594 595- if set to a true scalar value then multiple items with the same names in a section 596do not overwrite each other, but result in an array of the values. 597 598- if set to a hash of hashes (or hash of arrays or hash of comma separated item names) 599specifies what items in what sections will end up as 600hashes containing the list of values. All the specified items will be arrays, even if 601there is just a single value. To affect the items in all sections use section name '*'. 602 603By default false. 604 605=item forValue 606 607- allows you to install a callback that will be called for each value as soon as it is read 608but before it is stored in the hash. 609The function is called like this: 610 611 $value = $forValue->($name, $value, $sectionname, $INIhashref); 612 613If the callback returns an undef, the value will not be stored. 614 615=item comment 616 617- regular expression used to identify comments or a string containing the list of characters starting a comment. 618Each line is tested against the regexp is ignored if matches. If you specify a string a regexp like this will be created: 619 620 qr/^\s*[the_list]/ 621 622The default is 623 624 qr/^\s*[#;] 625 626=item layer 627 628- the IO layer(s) to use when opening the file. See perldoc C<perlopen>. 629 630If the file is in UTF8 and starts with a BOM it will be automaticaly opened in UTF8 mode and the BOM will be stripped. 631If it doesn't start with the BOM you have to specify the utf8 layer! 632 633=back 634 635You may also set the defaults for the options by modifying the $Config::IniHash::optionname 636variables. These default settings will be used if you do not specify the option in the ReadINI() 637or ReadSection() call. 638 639=head3 AddDefaults 640 641 AddDefaults( $config, 'normal section name', 'default section name'); 642 AddDefaults( $config, 'normal section name', \%defaults); 643 644This subroutine adds a some default values into a section. The values are NOT copied into the section, 645but rather the section knows to look up the missing options in the default section or hash. 646 647Eg. 648 649 if (exists $config->{':default'}) { 650 foreach my $section (keys %$config) { 651 next if $section =~ /^:/; 652 AddDefaults( $config, $section, ':default'); 653 } 654 } 655 656=head3 ReadSection 657 658 $hashreference = ReadSection ($string) 659 660This function parses a string as if it was a section of an INI file and creates a hash with the values. 661It accepts the same options as ReadINI. 662 663=head3 WriteINI 664 665 WriteINI ($filename, $hashreference) 666 667Writes the hash of hashes to a file. 668 669=head3 PrintINI 670 671The same as WriteINI(). 672 673=head1 AUTHOR 674 675Jan Krynicky <Jenda@Krynicky.cz> 676http://Jenda.Krynicky.cz 677 678=head1 COPYRIGHT 679 680Copyright (c) 2002-2005 Jan Krynicky <Jenda@Krynicky.cz>. All rights reserved. 681 682This program is free software; you can redistribute it and/or 683modify it under the same terms as Perl itself. 684 685=cut 686