inifiles.pm

支持全流程的Perl+MySQL电子商务系统。完全公开代码。

#	-parms  	reference to the $self->{parms}{$sect} of the parent
#
# Description: Builds the object that gets tied to the 
# sections name. Inserts the existing hash, defined in the 
# named parameter '-_current_value' into the tied hash.
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub TIEHASH {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my %parms = @_;
  
  # Make a new object
  my $self = {};
  
  # Put the passed hash into the holder
  $self->{v} = $parms{-_current_value};
  
  # Get all other the parms, removing leading '-', if any
  # Option checking is already handled in the IniFiles contructor
  foreach( keys %parms ) {
    s/^-//g;
    $self->{$_} = $parms{-$_};
  } # end foreach

  return bless( $self, $class );
} # end TIEHASH


# ----------------------------------------------------------
# Sub: IniFiles::_section::FETCH
#
# Args: $key
#	$key	The name of the key whose value to get
#
# Description: Returns the value associated with $key. If the
# value is an array and the context is scalar concatenates the 
# array with the default line separator character.
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# 2000Jun15 Fixed bugs in -default handler                JW
# 2000Dec07 Fixed another bug in -deault handler          JW
# ----------------------------------------------------------
sub FETCH {
  my $self = shift;
  my $key = shift;

  $key = lc($key) if( $self->{nocase} );

  my $val = $self->{v}{$key};
  
  unless( defined $self->{v}{$key} ) {
    $val = $self->{default}{$key} if ref($self->{default}) eq 'HASH';
  } # end unless

  if( ref($val) eq 'ARRAY' ) {
    # [ The FETCH method is never called in an array context, So 
    # this will always join. This seems like a bug in Perl to me.
    # Nonetheless maintain the wantarray in case this is fixed. -JW]

    return wantarray ? @$val : join($/, @$val);
  } else {
    return $val;
  } # end if
} # end FETCH


# ----------------------------------------------------------
# Sub: IniFiles::_section::STORE
#
# Args: $key, @val
#	$key	The key under which to store the value
#	@val	The value to store, either an array or a scalar
#
# Description: Sets the value for the specified $key
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# 2001Apr04 Fixed -nocase bug                             JW
# ----------------------------------------------------------
sub STORE {
  my $self = shift;
  my $key = shift;
  my @val = @_;

  $key = lc($key) if( $self->{nocase} );

  # Add the parameter the the parent's list if it isn't there yet
  push(@{$self->{parms}}, $key) unless (grep /^\Q$key\E$/, @{$self->{parms}});

  if (@val > 1) {
    $self->{v}{$key} = \@val;
  } else {
    $self->{v}{$key} = shift @val;
  }

  return $self->{v}{$key};
} # end STORE


# ----------------------------------------------------------
# Sub: IniFiles::_section::DELETE
#
# Args: $key
#	$key	The key to remove from the hash
#
# Description: Removes the specified key from the hash
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# 2001Apr04 Fixed -nocase bug                              JW
# ----------------------------------------------------------
sub DELETE   {
  my $self = shift;
  my $key = shift;

  $key = lc($key) if( $self->{nocase} );
#	@{$self->{parms}{$sect}} = grep !/^$parm$/, @{$self->{parms}{$sect}};
  return delete $self->{v}{$key};
} # end DELETE

# ----------------------------------------------------------
# Sub: IniFiles::_section::CLEAR
#
# Args: (None)
#
# Description: Empties the entire hash
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub CLEAR    {
  my $self = shift;

  foreach ( keys %{$self->{v}}) {
    $self->DELETE($_);
  } # end foreach

  return $self;
} # end CLEAR

# ----------------------------------------------------------
# Sub: IniFiles::_section::EXISTS
#
# Args: $key
#	$key	The key to look for
#
# Description: Returns whether the key exists
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# 2001Apr04 Fixed -nocase bug                             JW
# ----------------------------------------------------------
sub EXISTS   {
  my $self = shift;
  my $key = shift;
  $key = lc($key) if( $self->{nocase} );
  return exists $self->{v}{$key};
} # end EXISTS

# ----------------------------------------------------------
# Sub: IniFiles::_section::FIRSTKEY
#
# Args: (None)
#
# Description: Returns the first key in the hash
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub FIRSTKEY {
  my $self = shift;

  # Reset the each() iterator
  my $a = keys %{$self->{v}};

  return each %{$self->{v}};
} # end FIRST KEY

# ----------------------------------------------------------
# Sub: IniFiles::_section::NEXTKEY
#
# Args: $last
#	$last	The last key accessed by the interator
#
# Description: Returns the next key in line
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub NEXTKEY  {
  my $self = shift;
  my $last = shift;

  return each %{$self->{v}};
} # end NEXTKEY


# ----------------------------------------------------------
# Sub: IniFiles::_section::DESTROY
#
# Args: (None)
#
# Description: Called on cleanup
# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub DESTROY  {
  # my $self = shift
} # end DESTROY

# Eliminate annoying warnings
if ($^W)	{
	$IniFiles::VERSION = $IniFiles::VERSION;
}

1;

=head1 DIAGNOSTICS

=head2 @IniFiles::errors

Contains a list of errors encountered while parsing the configuration
file.  If the I<new> method returns B<undef>, check the value of this
to find out what's wrong.  This value is reset each time a config file
is read.

=head1 BUGS

=over 3

=item *

The output from [Re]WriteConfig/OutputConfig might not be as pretty as
it can be.  Comments are tied to whatever was immediately below them.
And case is not preserved for Section and Parameter names if the -nocase
option was used.

=item *

No locking is done by [Re]WriteConfig.  When writing servers, take
care that only the parent ever calls this, and consider making your
own backup.

=back

=head1 Data Structure

Note that this is only a reference for the package maintainers - one of the
upcoming revisions to this package will include a total clean up of the
data structure.

  $iniconf->{cf} = "config_file_name"
          ->{startup_settings} = \%orginal_object_parameters
          ->{firstload} = 0
          ->{nocase} = 0
          ->{reloadwarn} = 0
          ->{sects} = \@sections
          ->{sCMT}{$section} = \@comment_lines
          ->{group}{$group} = \@group_members
          ->{parms}{$section} = \@section_parms
          ->{EOT}{$sect}{$parm} = "end of text string"
          ->{pCMT}{$section}{$parm} = \@comment_lines
          ->{v}{$section}{$parm} = $value   OR  \@values

=head1 AUTHOR and ACKNOWLEDGEMENTS

The original code was written by Scott Hutton.
It has since been taken over by Rich Bowen,
with many contributions from various other people.

In particular, special thanks go to (in roughly chronological order):

Bernie Cosell, Alan Young, Alex Satrapa, Mike Blazer, Wilbert van de Pieterman,
Steve Campbell, Robert Konigsberg, Scott Dellinger, R. Bernstein,
Jeremy Wadsack, Daniel Winkelmann, Pires Claudio,  and Adrian Phillips.

Geez, that's a lot of people. And apologies to the folks I missed.

If you want someone to bug about this, that would be:

	Rich Bowen <rbowen at rcbowen dot com>

If you want more information, or want to participate, go to:

	http://sourceforge.net/projects/config-inifiles/

Please send bug reports to [e-mail]

Development discussion occurs on the mailing list
[e-mail], which you can subscribe
to by going to the project web site (link above).

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

=head1 Change log

     $Log: IniFiles.pm,v $
     Revision 2.19  2001/04/04 23:33:40  wadg
     Fixed case sensitivity bug

     Revision 2.18  2001/03/30 04:41:08  rbowen
     Small documentation change in IniFiles.pm - pod2* was choking on misplaces
     =item tags. And I regenerated the README
     The main reason for this release is that the MANIFEST in the 2.17 version was
     missing one of the new test suite files, and that is included in this
     re-release.

     Revision 2.17  2001/03/21 21:05:12  wadg
     Documentation edits

     Revision 2.16  2001/03/21 19:59:09 wadg
     410327 -default not in original; 233255 substring parameters

     Revision 2.15  2001/01/30 11:46:48  rbowen
     Very minor documentation bug fixed.

     Revision 2.14  2001/01/08 18:02:32  wadg
     [Bug #127325] Fixed proken import; changelog; moved

     Revision 2.13  2000/12/18 07:14:41  wadg
     [Bugs# 122441,122437] Alien EOLs and OO delete method

     Revision 2.12  2000/12/18 04:59:37  wadg
     [Bug #125524] Writing multiline of 2 with tied hash

     Revision 2.11  2000/12/16 12:53:13  grail
     [BUG #122455] Problem with File Permissions

     Revision 2.10  2000/12/13 17:40:18  rbowen
     Updated version number so that CPAN will stop being angry with us.

     Revision 1.18  2000/12/08 00:45:35  grail
     Change as requested by Jeremy Wadsack, for Bug 123146

     Revision 1.17  2000/12/07 15:32:36  grail
     Further patch to duplicate sections bug, and replacement of repeated values handling code.

     Revision 1.14  2000/11/29 11:26:03  grail
     Updates for task 22401 (no more reloadsig) and 22402 (Group and GroupMember doco)

     Revision 1.13  2000/11/28 12:41:42  grail
     Added test for being able to add sections with wierd names like section|version2

     Revision 1.11  2000/11/24 21:20:11  rbowen
     Resolved SourceForge bug #122445 - a parameter should be split from its value on the first = sign encountered, not on the last one. Added test suite to test this, and put test case in test.ini

     Revision 1.10  2000/11/24 20:40:58  rbowen
     Updated MANIFEST to have file list of new files in t/
     Updated IniFiles.pm to have mention of sourceforge addresses, rather than rcbowen.com addresses
     Regenerated README from IniFiles.pm

     Revision 1.9  2000/11/23 05:08:08  grail
     Fixed documentation for bug 122443 - Check that INI files can be created from scratch.

     Revision 1.1.1.1  2000/11/10 03:04:01  rbowen
     Initial checkin of the IniFiles source to SourceForge

     Revision 1.8  2000/10/17 01:52:55  rbowen
     Patch from Jeremy. Fixed "defined" warnings.

     Revision 1.7  2000/09/21 11:19:17  rbowen
     Mostly documentation changes. I moved the change log into the POD rather
     than having it in a separate Changes file. This allows people to see the
     changes in the Readme before they download the module. Now I just
     need to make sure I remember to regenerate the Readme every time I do
     a commit.


     1.6 September 19, 2000 by JW, AS
     * Applied several patches submitted to me by Jeremy and Alex.
     * Changed version number to the CVS version number, so that I won't
     have to think about changing it ever again. Big version change
     should not be taken as a huge leap forward.

     0.12 September 13, 2000 by JW/WADG
     * Added documentation to clarify autovivification issues when 
     creating new sections
     * Fixed version number (Oops!)

     0.11 September 13, 2000 by JW/WADG
     * Applied patch to Group and GroupMembers functions to return empty
     list when no groups are present (submitted by John Bass, Sep 13)

     0.10 September 13, 2000 by JW/WADG
     * Fixed reference in POD to ReWriteFile. changes to RewriteConfig
     * Applied patch for failed open bug submitted by Mordechai T. Abzug Aug 18
     * Doc'd behavior of failed open
     * Removed planned SIG testing from test.pl as SIGs have been removed
     * Applied patch from Thibault Deflers to fix bug in parameter list
     when a parameter value is undef

     0.09
     Hey! Where's the change log for 0.09?

     0.08
     2000-07-30  Adrian Phillips  <[e-mail]>
 
     * test.pl: Fixed some tests which use $\, and made those that try
     to check a non existant val check against ! defined.

     * IniFiles.pm: hopefully fixed use of $\ when this is unset
     (problems found when running tests with -w).  Similar problem with
     $/ which can be undefined and trying to return a val which does
     not exist. Modified val docs section to indicate a undef return
     when this occurs.

     0.07
     Looks like we missed a change log for 0.07. Bummer.

     0.06 Sun Jun 25, 2000 by Daniel Winkelmann
     * Patch for uninitialized value bug in newval and setval
     
     0.05 Sun Jun 18, 2000 by RBOW
     * Added something to shut up -w on VERSIONS
     * Removed unused variables

     0.04 Thu Jun 15 - Fri Jun 16, 2000 by JW/WADG
     * Added support for -import option on ->new
     * Added support for tying a hash
     * Edited POD for grammer, clarity and updates
     * Updated test.pl file
     * Fixed bug in multiline/single line output
     * Fixed bug in default handling with tie interface
     * Added bugs to test.pl for regression
     * Fixed bug in {group} vs. {groups} property (first is valid)
     * Fixed return value for empty {sects} or {parms}{$sect} in
     Sections and Parameters methods

     0.03 Thu Jun 15, 2000 by RBOW
     * Modifications to permit 'use strict', and to get 'make test' working
     again.

     0.02 Tue Jun 13, 2000 by RBOW
     * Fixed bug reported by Bernie Cosell - Sections, Parameters, 
     and GroupMembers return undef if there are no sections,
     parameters, or group members. These functions now return
     () if the particular value is undefined.
     * Added some contributed documentation, from Alex Satrapa, explaining
     how the internal data structure works. 
     * Set up a project on SourceForge. (Not a change, but worth
     noting).
     * Added Groups method to return a list of section groups.

     0.01  Mon Jun 12, 2000 by RBOW
     Some general code cleanup, in preparation for changes to
     come. Put up Majordomo mailing list and sent invitation to
     various people to join it.

=cut