package Win32API::Ini;
use strict;
use warnings;
use Win32::API;
#use Tie::IxHash;
=pod

=head1 NAME

Win32API::Ini

=head1 SYNOPSIS

use Win32API::Ini

  Provides a means to read and write from private profiles (*.ini) files using Win32 API calls.

=cut

BEGIN {
        use Exporter   ();
        our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

        # set the version for version checking
        $VERSION     = 1.00;
        @ISA         = qw(Exporter);
        @EXPORT      = qw(
                        iniDeleteSection iniDeleteKey iniEnumKeys
                        iniEnumSections iniReadSection iniWriteSection
                        iniReadInteger iniReadString iniWriteString
                        );
        %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

        # your exported package globals go here,
        # as well as any optionally exported functions
        @EXPORT_OK   = qw();
}
our @EXPORT_OK;
our $VERSION="1.00";

our $gppInt    =new Win32::API('kernel32','GetPrivateProfileIntA'      ,'PPNP'  ,'N');
our $gppSection=new Win32::API('kernel32','GetPrivateProfileSectionA'  ,'PPNP'  ,'N');
our $gppString =new Win32::API('kernel32','GetPrivateProfileStringA'   ,'PPPPNP','N');
our $wppSection=new Win32::API('kernel32','WritePrivateProfileSectionA','PPP'   ,'N');
our $wppString =new Win32::API('kernel32','WritePrivateProfileStringA' ,'PPPP'  ,'N');

=head1 DESCRIPTION

  Ini files are text files containing configuration information for a
  specific application. Similar to registry entries, ini files are
  structured with section headers with key-value pairs underneath the
  headers. Such as:

  [section]
  key=value    ;comment

  This module provides methods to read, write, delete, and enumerate
  sections, keys, and values within an ini file. It does not provide a
  means for adding comments to an ini file.

  In using the iniWrite* functions, if no path is specified in the
  $ini_file parameter, the function will create a new ini file if one
  does not exist.  The new ini file will be created in the $ENV{windir}
  directory.  If a relative or absolute path is specified in the
  $ini_file parameter, a new ini file will not be created.

  Please also note that despite its description, ini files are not
  required to end with the extension 'ini'.  That is a convention.
  They are merely text files that can be named anything you like.

=head1 EXPORTED FUNCTIONS

=over 3

=item iniReadString()

Reads the value from a key in a section (as a string)

$return=iniReadString($section_name, $key_name, $default_string, $ini_file);

Returns keyvalue if succeeds, $default_string if fails

=cut

sub iniReadString($$$$) {
    unless ($^O eq "MSWin32") {return 0;}
    my $retval=0;
    my ($section_name, $key_name, $default, $ini_file)=@_;
    my $buflen=100;
    my $buffer;
    my $escape=0;
    until ($retval or $escape>3) {
        $escape++;
        $buffer = " " x $buflen;
        $retval=$gppString->Call($section_name,$key_name,$default,$buffer,$buflen,$ini_file);
        if ($retval==$buflen-1) {
            $retval=0;
            $buflen=$buflen+100;
        } elsif ($retval==0) {
            $retval=$default;
            last;
        } else {
            $retval=substr($buffer,0,$retval);
        }

    }
    return $retval;
}

=item iniReadInteger()

Reads the value from a key in a section (as an integer)

$return=iniReadInteger($section_name, $key_name, $default_integer, $ini_file);

Returns keyvalue if succeeds, $default_integer if fails

=cut

sub iniReadInteger($$$$) {
    unless ($^O eq "MSWin32") {return 0;}
    my $retval;
    my ($section_name, $key_name, $default, $ini_file)=@_;
    $retval=$gppInt->Call($section_name, $key_name, $default, $ini_file);
    return $retval;
}

=item iniReadSection()

Reads an entire section

@return=iniReadSection($section_name, $ini_file);

Returns ('key1=value1', 'key2=value2', etc.) if succeeds; () if fails

=cut

sub iniReadSection($$) {
    unless ($^O eq "MSWin32") {return ();}
    my $retval;
    my @retvals;
    my ($section_name, $ini_file)=@_;
    my $buflen=1000;
    my $buffer;
    until ($retval) {
        $buffer=" " x $buflen;
        $retval=$gppSection->Call($section_name, $buffer, $buflen, $ini_file);
        if ($retval==$buflen-2) {
            $retval=0;
            $buflen=$buflen+1000;
        } elsif ($retval==0) {
            $retval=1;
        } else {
            $retval=substr($buffer,0,$retval-1);
            @retvals=split /\000+/, $retval;
        }
    }
    return @retvals;
}

=item iniWriteString()

Writes a key-value pair to a section

$return=iniWriteString($section_name, $key_name, $value_string, $ini_file);

Returns non-zero if succeeds, zero if fails.

=cut


sub iniWriteString($$$$) {
        unless ($^O eq "MSWin32") {return 0;}
        my $retval;
        my ($section_name, $key_name, $out_string, $ini_file)=@_;
        if ($out_string=~/^\x30$/) {$out_string='0'}
        $retval=$wppString->Call($section_name, $key_name, $out_string, $ini_file);
        return $retval;
}

=item iniWriteSection()

Writes an entire section using null-delimited key-value pairs within a single string

$return=iniWriteSection($section_name, $key_value_pair_string, $ini_file);

Returns non-zero if succeeds, zero if fails

=cut


sub iniWriteSection($$$) {
    unless ($^O eq "MSWin32") {return 0;}
    my $retval;
    my ($section_name, $out_string, $ini_file)=@_;
    $retval=$wppSection->Call($section_name,$out_string,$ini_file);
    return $retval;
}


=item iniDeleteKey()

Deletes a key-value pair from a section

$return=iniDeleteKey($section_name, $key_name, $ini_file);

Returns non-zero if okay, returns zero if fails.

=cut


sub iniDeleteKey($$$) {
    unless ($^O eq "MSWin32") {return 0;}
    my $retval;
    my ($section_name, $key_name, $ini_file)=@_;
    my $nullstring=0;
    $retval=$wppString->Call($section_name,$key_name,$nullstring,$ini_file);
    return $retval;
}

=item iniDeleteSection()

Deletes an entire section from an ini file

$return=iniDeleteSection($section_name, $ini_file);

Returns non-zero if okay, returns zero if fails.

=cut

sub iniDeleteSection($$) {
    unless ($^O eq "MSWin32") {return 0;}
    my $retval;
    my ($section_name, $ini_file)=@_;
    my $nullstring=0;
    $retval=$wppString->Call($section_name, $nullstring, $nullstring, $ini_file);
    return $retval;
}

=item iniEnumKeys()

Enumerates all keys within a section

@return=iniDeleteSection($section_name, $ini_file);

Returns: ('key1', 'key2', etc.) if succeeds; () if fails

=cut

sub iniEnumKeys($$) {
    unless ($^O eq "MSWin32") {return ();}
    my $retval=0;
    my @retvals;
    my ($section_name, $ini_file)=@_;
    my $buffer;
    my $buflen = 1000;
    my $nullstring=0;
    my $emptystring="";
    until ($retval) {
        $buffer=" " x $buflen;
        $retval=$gppString->Call($section_name,$nullstring,$emptystring,$buffer,$buflen,$ini_file);
        if ($retval==$buflen-2) {
            $retval=0;
            $buflen=$buflen+1000;
        } elsif ($retval==0) {
            @retvals=();
            $retval=1;
        } else {
            $retval=substr($buffer,0,$retval-1);
            @retvals=split /\000+/, $retval;
        }
    }
    return @retvals;
}

=item iniEnumSections()

Enumerates all sections within a ini file

@return=iniDeleteSection($ini_file);

Returns: ('section1', 'section2', etc.) if succeeds; () if fails

=cut

sub iniEnumSections($) {
    unless ($^O eq "MSWin32") {return ();}
    my $retval=0;
    my @retvals;
    my $ini_file;
    if (@_) {($ini_file)=@_;} else { return ();}
    unless ($ini_file) { return (); }
    my $nullstring=0;
    my $buflen=1000;
    my $emptystring="";
    my $buffer="";
    until ($retval) {
        $buffer=" " x $buflen;
        $retval=$gppString->Call($nullstring,$nullstring,$emptystring,$buffer,$buflen,$ini_file);
        if ($retval==$buflen-2) {
            $retval=0;
            $buflen=$buflen+1000;
        } elsif ($retval==0) {
            $retval=1;
            @retvals=();
        } else {
            $retval=substr($buffer,0,$retval-1);
            @retvals=split /\000+/, $retval;
        }
    }
    return @retvals;
}

=item iniReadFile($)

Reads entire ini file and returns hash ref

$ini_hash_ref=iniReadSection($ini_file);

If successful, returns:

{ section1 => {key1 => value1,  key2 => value2} ,
                                                             section2 => {key3 => value3, key4=>value4}
                                }

otherwise:  ()

=cut

sub iniReadFile($) {
    my $ini_file;
    my %ret;
  #  tie %ret, "Tie::IxHash";
    my $section;
    my @keys;
    my $key;
    my $value;

    unless ($^O eq "MSWin32") {return ();}
    #$ini_file=@_;
    unless (($ini_file)=@_) {return();}
    my @sections=iniEnumSections($ini_file);
    foreach $section (@sections) {
        my @keys=iniEnumKeys($section,$ini_file);
        foreach $key (@keys) {
            my $value=iniReadString($section,$key,0,$ini_file);
            $ret{$section}{$key}=$value;
        }
    }
    return \%ret;
}
sub iniWriteFile($$){
#supply a hash reference followed by a filename
    my ($inihashref,$ini_file)=@_;
    my %inihash;
 #   tie %inihash, "Tie::IxHash";
    %inihash=%$inihashref;


    my $section;
    my $keyhashref;
    my %keyhash;
  # tie %keyhash, "Tie::IxHash";
    my $key;
    my $value;

    while (($section, $keyhashref)=each(%inihash)) {
        my %keyhash=%$keyhashref;
        while (($key, $value)=each(%keyhash)) {
            iniWriteString($section,$key,$value,$ini_file);
        }
    }
    return;
}

=back

=head1 AUTHOR

Written by Travis Krumsick 4/16/2003

=head1 SEE ALSO

http://msdn.microsoft.com for API documentation

Config::Ini module for Unix compatibility

=head1 COPYRIGHT

Copyright (c) 2003 Eastman Kodak. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
