ok, heres the code as it stands. Some outstanding issues:

• Would supporting segments as handles be worthwhile?
• I removed the :subs option and replaced with the probably more useful :cdata. Any other ideas for likely defaults?
• Currently the code croak()s if any attempt at modifying %DATA is made. Too strict?
• The regexes are fairly simple-minded, any advice is welcome

cheers,

package Tie::DATA;

use strict;
use warnings;
use Carp;

my %modules   = ();
my %regexen   = ();
my %callbacks = ();
my %handles   = ();
my $reserved  = undef;

##
# Default handlers for parsing DATA segments
# NB: these can be code refs that return a list of key/value pairs, 
#     default is to use as regex in split() call.
# 
my %defaults  =
(
    ':ini'        => '(?:\r?\n)*[\[\]](?:\r?\n)*',
    ':underscore' => '\s*__(\S+)__\s*',
    ':define'     => '\s*#define\s+(\w+)\s+',
    ':cdata'      => sub{$_ = shift or return; 
                         return(m#\s*<!\[(\w+?)\[(.*?)\]\]>\s*#sgoi);
                     },
    ':xml'        => sub{$_ = shift or return; 
                         return(m#\s*<(\w+)>([^<]*?)</\1>\s*#sgoi);
                     },
);

$defaults{':default'} = $defaults{':underscore'};
$reserved             = join('|', keys %defaults);

##
# parse arguments and tie callers %DATA
#
sub import
{
    my $package = shift;
    my $regex   = shift;
    my $cback   = shift;
    my $caller  = caller;

    $regex = $defaults{$regex}     if($regex && $regex =~ /^$reserved$
+/);
    $regex = $defaults{':default'} unless $regex;

    if(!exists $modules{$caller})
    {
        no strict 'refs';

        # fix stringy code ref...allow relative or absolute naming
        if($cback && !ref($cback))
        {
            $cback = ($cback =~ /\:\:/go) ? \&{$cback} : 
                                            \&{$caller."\::".$cback}; 
        }

        *{"$caller\::DATA"} = {};
        tie %{"$caller\::DATA"}, $package, $caller;

        $handles{$caller}   = \*{$caller."::DATA"};
        $modules{$caller}   = undef;
        $regexen{$caller}   = (ref $regex) ? $regex : qr($regex);
        $callbacks{$caller} = $cback;

    }
}

##
# read DATA handle 
# cant do during import as perl hasnt parsed that far by then
#
sub _read_data
{
    my $self = shift;

    if(! defined $modules{$$self})
    {
        my (@data, $data, $tell, $rex, $code);
        $rex  = delete $regexen{$$self};
        $code = delete $callbacks{$$self};
        $data = delete $handles{$$self};

        {
            # slurp and split...
            no warnings;
            local $/ = undef;

            $tell = tell($data);
            Carp::croak("Error: $$self has no __DATA__ section")
                if ($tell < 0);

            @data = (ref($rex) eq "CODE") ? $rex->(<$data>)  : 
                                            split(/$rex/, <$data>);
            $modules{$$self} = {} and return unless @data;
        }

        # remove empty elements...depends on syntax used
        shift @data if $data[0]  =~ /^\s*$/o;
        pop   @data if $data[-1] =~ /^\s*$/o;
        Carp::croak("Error: \%$$self\::DATA - bad key/value pairs\n")
            if (@data% 2);
        
        #  trim keys and invoke any callbacks...
        for(my $i=0; $i<@data; $i+=2)
        {
            $data[$i] =~ s#^\s*(.*?)\s*$#$1#sgoi;
            next unless $data[$i];

            if($code)
            {
                ($data[$i], $data[$i+1]) = $code->($data[$i], $data[$i
++1]);
            }
        }
        
        $modules{$$self} = {@data};     # coerce into hashref
        seek($data, $tell,0);           # cover our tracks
    }
}


##
# TIE HASH interface (read-only)
# not much to see here...
#

sub TIEHASH 
{
    my $class  = shift;
    my $caller = shift;
    return bless \$caller, $class;
}

sub FETCH 
{
    my $self = shift;
    my $key  = shift;
    $self->_read_data if(! defined $modules{$$self});
    return $modules{$$self}{$key};
}

sub EXISTS
{
    my $self = shift;
    my $key  = shift;
    $self->_read_data if(! defined $modules{$$self});
    return exists $modules{$$self}{$key};
}

sub FIRSTKEY
{
    my $self = shift;
    $self->_read_data if(! defined $modules{$$self});
    my $a = keys %{$modules{$$self}};
    return each %{$modules{$$self}};
}

sub NEXTKEY
{
    my $self = shift;
    $self->_read_data if(! defined $modules{$$self});
    return each %{ $modules{$$self} }
}

sub DESTROY
{
    my $self = shift;
    $modules{$$self} = undef; 
}

sub STORE 
{
    my $self = shift;
    my $k    = shift;
    my $v    = shift;
    #$self->_read_data if(! defined $modules{$$self});
    Carp::croak("Attempt to store key ($k) in read-only hash %".$$self
+."::DATA");
}

sub DELETE   
{
    my $self = shift;
    my $k    = shift;
    #$self->_read_data if(! defined $modules{$$self});
    Carp::croak("Attempt to delete key ($k) from read-only hash %".$$s
+elf."::DATA");
}

sub CLEAR    
{
    my $self = shift;
    #$self->_read_data if(! defined $modules{$$self});
    Carp::croak("Attempt to clear read-only hash %".$$self."::DATA");
}


1;
[download]