view release on metacpan or  search on metacpan

lib/App/IniDiff/IniFile.pm  view on Meta::CPAN

=item * package App::IniDiff::IniFile::Field;

=item * package App::IniDiff::IniFile::Key;

=item * package App::IniDiff::IniFile::Filter;

=back

Creates the following data structure:

    {
        'nextOrderId' => some-number,
        'keys' => {
          {
            'name' => "...",
            'orderId' => some number,
            'fields' => [
                {
                    'name' => "..."
                    'value' => "...",
                    'deleted' => 0 or 1,
                    'annotation' => "...",
                },
                ...
                ],
            'deleted' => 0 or 1,
            'annotation' => "...",
            },
            ...
        },
    }

=over 4

=item * 'orderId' is used to preserve the order in which keys appear in a file.

=item * 'annotation' is used to decorate inidiff output.

=item * 'deleted' is used when generating, writing, reading, and applying patch files.

=back

Some terms used differ from what is normally used in WinINI file-speak

=over 4

=item * 'key' is INI 'section'

=item * 'field' is INI 'entry'

=item * 'field name' is INI 'key'

=item * 'field value' is INI 'value'

=back

=cut

use vars qw(&new &write &findKey &keys &removekey &addKey);

# added eol to support old end of line \r\n
use vars qw($errorString $eol $commentchars);    

{

    package App::IniDiff::IniFile::Field;

    use strict;
    use Carp;

    use vars qw(&new &name &canonName &value &deleted &annotation
      &setFrom &write &canonicalize );
    use vars qw($eol);

    # end of line character - eol
    $eol = "\n";

    sub new
    {
        my $proto = shift;
        confess "new App::IniDiff::IniFile::Field takes 4 arguments" if @_ != 4;
        my ($name, $value, $del, $annotation) = @_;

        my $field = {
            'name'       => $name,
            'canonName'  => canonicalize($name),
            'value'      => $value,
            'deleted'    => $del,
            'annotation' => $annotation,
        };

        bless $field, (ref($proto) || $proto);
        return $field;
    }

    sub name {
        my $field = shift;
        if (@_) { $field->{'name'} = shift }
        return $field->{'name'};
    }

    sub canonName {
        my $field = shift;
        if (@_) { $field->{'canonName'} = shift }
        return $field->{'canonName'};
    }

    sub value {
        my $field = shift;
        if (@_) { $field->{'value'} = shift }
        return $field->{'value'};
    }

    sub deleted {
        my $field = shift;
        if (@_) { $field->{'deleted'} = shift }
        return $field->{'deleted'};
    }

    sub annotation {
        my $field = shift;
        if (@_) { $field->{'annotation'} = shift }
        return $field->{'annotation'};
    }

    sub setFrom
    {
        my $field = shift;
        my $from  = shift;
        $field->name($from->name);
        $field->value($from->value);
        $field->deleted($from->deleted);
        $field->annotation($from->annotation);
        return $field;
    }

    sub canonicalize
    {

        # Called as object method
        if (@_ > 0 && ref $_[0]) {
            return ${$_[0]}->canonName if (@_ == 1);
        }

        # Called as object or class method with argument
        if (@_ == 2) {
            shift;
        }
        elsif (@_ != 1) {
            confess "wrong number of args" if (@_ != 0);
        }
        my $name = $_[0];
        $name =~ tr/A-Z/a-z/;
        return $name;
    }

    sub write
    {
        my ($field, $fileHandle) = @_;

        print $fileHandle "; ", $field->annotation, $eol
          if defined $field->annotation;
        print $fileHandle $field->name;
        if ($field->deleted) {
            print $fileHandle "-";
        }
        elsif (defined $field->value) {
            print $fileHandle "=", $field->value;
        }
        print $fileHandle $eol;
    }
}    # End package App::IniDiff::IniFile::Field;

{

    package App::IniDiff::IniFile::Key;

    use strict;
    use Carp;
    use IO::File;

    use vars qw(&new &name &canonName &orderId &deleted &annotation &fields
      &canonicalize &findField &addField &appendField &removeField
      &write
    );
    use vars qw($eol);

    # end of line character - eol
    $eol = "\n";

    sub new
    {
        my $proto = shift;
        confess "new App::IniDiff::IniFile::Key takes 3 arguments" if @_ != 3;
        my ($name, $del, $annotation) = @_;

        my $key = {
            'name'       => $name,
            'canonName'  => canonicalize($name),
            'orderId'    => undef,
            'deleted'    => $del,
            'annotation' => $annotation,
            'fields'     => [],
        };

        bless $key, (ref($proto) || $proto);
        return $key;
    }

    sub name {
        my $key = shift;

        # Do not change canonName (see kludge in App::IniDiff::IniFile::new regarding patches)
        if (@_) { $key->{'name'} = shift }
        return $key->{'name'};
    }

    sub canonName {
        my $key = shift;
        if (@_) { $key->{'canonName'} = shift }
        return $key->{'canonName'};
    }

    sub orderId {
        my $key = shift;
        if (@_) { $key->{'orderId'} = shift }
        return $key->{'orderId'};
    }

    sub deleted {
        my $key = shift;
        if (@_) { $key->{'deleted'} = shift }
        return $key->{'deleted'};
    }

    sub annotation {
        my $key = shift;
        if (@_) { $key->{'annotation'} = shift }
        return $key->{'annotation'};
    }

    sub fields {
        my $key = shift;
        confess "too many args" if @_ > 0;
        return $key->{'fields'};
    }

    sub canonicalize
    {

lib/App/IniDiff/IniFile.pm  view on Meta::CPAN

    sub addField
    {
        my $key   = shift;
        my $field = shift;

        my $xfield = $key->findField($field->name);
        if (defined $xfield) {
            $xfield->setFrom($field);
            return $xfield;
        }
        return $key->appendField($field);
    }

    sub appendField
    {
        my $key   = shift;
        my $field = shift;

        push(@{$key->fields}, $field);
        return $field;
    }

    #
    # Remove a field, either by name or by reference
    #
    sub removeField
    {
        my $found = 0;
        my ($key, $arg) = @_;

        if (ref $arg) {
            my $fieldToast = $arg;
            for (my $i = 0 ; $i < @{$key->fields} ; $i++) {
                my $field = ${$key->fields}[$i];
                if ($field eq $fieldToast) {
                    splice(@{$key->fields}, $i, 1);
                    $i--;
                    $found++;
                }
            }
        }
        else {
            my $fieldName = App::IniDiff::IniFile::Field->canonicalize($arg);
            for (my $i = 0 ; $i < @{$key->fields} ; $i++) {
                my $field = ${$key->fields}[$i];
                if ($field->canonName eq $fieldName) {
                    splice(@{$key->fields}, $i, 1);
                    $i--;
                    $found++;
                }
            }
        }
        return $found;
    }

    sub write
    {
        my ($key, $fileHandle) = @_;
        my ($del) = $key->deleted ? '-' : '';

        print $fileHandle "; ", $key->annotation, $eol
          if defined $key->annotation;
        print $fileHandle "[", $key->name, "]", $del, $eol;
        if (!$key->deleted) {
            my $field;
            foreach $field (@{$key->fields}) {
                $field->write($fileHandle);
            }
        }
        print $fileHandle $eol;
    }
}    # End package App::IniDiff::IniFile::Key;

# $IniFile package Globals
$errorString = undef;

# end of line character - eol
$eol          = "\n";
$commentchars = ';#';    # Allow DOS and Unix style comment.

sub new
{
    my $proto = shift;

    my $ini = {

        # Used to generate monotonically increasing key ids - used
        # to reserve order of ini file.
        'nextOrderId' => 0,
        'keys'        => {},
    };

    bless $ini, (ref($proto) || $proto);

    return $ini if (@_ == 0);
    confess "new called with too many arguments" if (@_ > 4);

    my ($fileHandle, $isPatch, $addM, $stripComments) =
      @_;    # Patches: allow duplicate key names
    my ($key);
    my $ok = 1;

    $isPatch = 0 if !defined $isPatch;
    $addM    = 0 if !defined $addM;      # add ^M if pre-NT
    $stripComments = 0 if ! defined $stripComments;  
    # strip out trailing inline comments having semicolon
    # comment out stripComments if isPatch 
    # - this may be a problem 
    # - leave them in unless specifically asked
    # $stripComments = 1 if $isPatch; # always strip out comments from patches
    if ($addM == 1) {
        $eol = "\r\n";

        # set the children's eol members to this value as well ... 
        # not using set() methods - oh dear
        $App::IniDiff::IniFile::Key::eol   = "\r\n";
        $App::IniDiff::IniFile::Field::eol = "\r\n";
    }

    while (<$fileHandle>) {
        chomp;

        #
        # Strip comments - not in key names ([...]) and not in strings..
        #
        # if a [key] section
        if (/^\s*(\[[^]]+])(.*)$/) {
            my ($key, $rest) = ($1, $2);

            # do care if it strips comments after [key] section
            if ($stripComments) {
                $rest =~ s/[$commentchars].*//;
            }
            $_ = $key . $rest;
        }

        # not a comment starting with ; and has a " in it
        elsif (!/^\s*[$commentchars]/ && /"/) {

            # Slow, but perl won't go exponential...
            my $line = '';

            # walk through non comments and matched quoted strings 
            # from left to right
            # until we hit a comment character or a non matched quote
            while (/^([^"$commentchars]*"[^"]*")(.*)/) {
                $line .= $1;
                $_ = $2;
            }

            # Some (burnt) ini files have unmatched quotes... rather
            # than toast these, we assume they have no comments.
            if (!/"/) {

                # do not strip comments unless requested
                if ($stripComments) {
                    s/[$commentchars].*//;
                }
            }
            $_ = $line . $_;
        }
        elsif ($stripComments) {
            s/[$commentchars].*//;
        }
        s/\s*$//;    # remove trailing space includes \r...
         # not skipping blank lines at this point results in errors when diffing
        next if /^$/;    # skip blank lines
        if (/^\s*\[([^]]+)](-?)$/) {
            my ($name, $del) = ($1, $2);
            if ($isPatch) {

                # Patches are a bit strange as there can be duplicate
                # key names - to deal with this, the canonName (hash index)
                # is a generated (unique) thing and we fix up the real name
                # after the key is created.
                $key = $ini->addKey(
                    new App::IniDiff::IniFile::Key(