diff --git a/README.md b/README.md new file mode 100644 index 0000000..fbe9b61 --- /dev/null +++ b/README.md @@ -0,0 +1,70 @@ +# Tie::Hash::DataSection ![static](https://github.com/uperl/Tie-Hash-DataSection/workflows/static/badge.svg) ![linux](https://github.com/uperl/Tie-Hash-DataSection/workflows/linux/badge.svg) + +Access \_\_DATA\_\_ section via tied hash + +# SYNOPSIS + +```perl +use Tie::Hash::DataSection; + +tie my %ds, 'Tie::Hash::DataSection'; + +# "Hello World\n" +print $ds{foo}; + +__DATA__ +@@ foo +Hello World +``` + +# DESCRIPTION + +This is a simple tie class that allows you to access data section +content via a Perl hash interface. + +# CONSTRUCTOR + +``` +tie %hash, 'Tie::Hash::DataSection'; +tie %hash, 'Tie::Hash::DataSection', $package; +tie %hash, 'Tie::Hash::DataSection', $package, @plugins; +``` + +The optional `$package` argument can be used to change which +package's `__DATA__` section will be read from. + +The optional `@plugins` array contains a list of [Data::Section::Pluggable](https://metacpan.org/pod/Data::Section::Pluggable) +plugins. These can either be a: + +- string + + ``` + tie %hash, 'Tie::Hash::DataSection', __PACKAGE__, $plugin; + ``` + + the name of the plugin, for example `trim` or `json`. + +- array reference + + ``` + tie %hash, 'Tie::Hash::DataSection', __PACKAGE__, [$plugin, @args]; + ``` + + The first element of the array is a plugin name, subsequent values + will be passed in as arguments to the plugin. + +# SEE ALSO + +- [Data::Section::Pluggable](https://metacpan.org/pod/Data::Section::Pluggable) +- [Data::Section::Writer](https://metacpan.org/pod/Data::Section::Writer) + +# AUTHOR + +Graham Ollis + +# COPYRIGHT AND LICENSE + +This software is copyright (c) 2024 by Graham Ollis. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff --git a/dist.ini b/dist.ini index aa54c4f..1c57279 100644 --- a/dist.ini +++ b/dist.ini @@ -20,5 +20,3 @@ version_plugin = PkgVersion::Block [Author::Plicease::Upload] cpan = 1 - - diff --git a/lib/Tie/Hash/DataSection.pm b/lib/Tie/Hash/DataSection.pm index 4bdf876..76ef109 100644 --- a/lib/Tie/Hash/DataSection.pm +++ b/lib/Tie/Hash/DataSection.pm @@ -1,9 +1,120 @@ use warnings; use 5.020; -use experimental qw( postderef signatures ); +use experimental qw( signatures ); +use stable qw( postderef ); use true; package Tie::Hash::DataSection { # ABSTRACT: Access __DATA__ section via tied hash + +=head1 SYNOPSIS + + use Tie::Hash::DataSection; + + tie my %ds, 'Tie::Hash::DataSection'; + + # "Hello World\n" + print $ds{foo}; + + __DATA__ + @@ foo + Hello World + +=head1 DESCRIPTION + +This is a simple tie class that allows you to access data section +content via a Perl hash interface. + +=head1 CONSTRUCTOR + + tie %hash, 'Tie::Hash::DataSection'; + tie %hash, 'Tie::Hash::DataSection', $package; + tie %hash, 'Tie::Hash::DataSection', $package, @plugins; + +The optional C<$package> argument can be used to change which +package's C<__DATA__> section will be read from. + +The optional C<@plugins> array contains a list of L +plugins. These can either be a: + +=over 4 + +=item string + + tie %hash, 'Tie::Hash::DataSection', __PACKAGE__, $plugin; + +the name of the plugin, for example C or C. + +=item array reference + + tie %hash, 'Tie::Hash::DataSection', __PACKAGE__, [$plugin, @args]; + +The first element of the array is a plugin name, subsequent values +will be passed in as arguments to the plugin. + +=back + +=head1 SEE ALSO + +=over 4 + +=item L + +=item L + +=back + +=cut + + use Data::Section::Pluggable 0.08; + use Ref::Util qw( is_plain_arrayref ); + + sub TIEHASH ($class, $package=undef, @plugins) { + $package //= caller; + my $dsp = Data::Section::Pluggable->new( + package => $package, + ); + foreach my $plugin (@plugins) { + if(is_plain_arrayref $plugin) { + my($name, @args) = @$plugin; + $dsp->add_plugin($name => @args); + } else { + $dsp->add_plugin($plugin); + } + } + return bless [$dsp], $class; + } + + sub FETCH ($self, $key) { + return $self->[0]->get_data_section($key); + } + + sub EXISTS ($self, $key) { + exists $self->[0]->get_data_section->{$key}; + } + + sub FIRSTKEY ($self) { + $self->[1] = [keys $self->[0]->get_data_section->%*]; + return $self->NEXTKEY; + } + + sub NEXTKEY ($self, $=undef) { + return shift $self->[1]->@*; + } + + sub STORE ($self, $, $) { + require Carp; + Carp::croak("hash is read-only"); + } + + sub DELETE ($self, $) { + require Carp; + Carp::croak("hash is read-only"); + } + + sub CLEAR ($self) { + require Carp; + Carp::croak("hash is read-only"); + } } diff --git a/t/00_diag.t b/t/00_diag.t new file mode 100644 index 0000000..70de682 --- /dev/null +++ b/t/00_diag.t @@ -0,0 +1,90 @@ +use Test2::V0 -no_srand => 1; +use Config; + +eval { require 'Test/More.pm' }; + +# This .t file is generated. +# make changes instead to dist.ini + +my %modules; +my $post_diag; + +$modules{$_} = $_ for qw( + Data::Section::Pluggable + ExtUtils::MakeMaker + Ref::Util + Test2::V0 + stable + true +); + + + +my @modules = sort keys %modules; + +sub spacer () +{ + diag ''; + diag ''; + diag ''; +} + +pass 'okay'; + +my $max = 1; +$max = $_ > $max ? $_ : $max for map { length $_ } @modules; +our $format = "%-${max}s %s"; + +spacer; + +my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV; + +if(@keys > 0) +{ + diag "$_=$ENV{$_}" for @keys; + + if($ENV{PERL5LIB}) + { + spacer; + diag "PERL5LIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERL5LIB}; + + } + elsif($ENV{PERLLIB}) + { + spacer; + diag "PERLLIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERLLIB}; + } + + spacer; +} + +diag sprintf $format, 'perl', "$] $^O $Config{archname}"; + +foreach my $module (sort @modules) +{ + my $pm = "$module.pm"; + $pm =~ s{::}{/}g; + if(eval { require $pm; 1 }) + { + my $ver = eval { $module->VERSION }; + $ver = 'undef' unless defined $ver; + diag sprintf $format, $module, $ver; + } + else + { + diag sprintf $format, $module, '-'; + } +} + +if($post_diag) +{ + spacer; + $post_diag->(); +} + +spacer; + +done_testing; + diff --git a/t/tie_hash_datasection.t b/t/tie_hash_datasection.t index d8f3fab..b85e427 100644 --- a/t/tie_hash_datasection.t +++ b/t/tie_hash_datasection.t @@ -1,6 +1,33 @@ use Test2::V0 -no_srand => 1; use Tie::Hash::DataSection; -ok 1, 'todo'; +subtest 'basic' => sub { + tie my %tie, 'Tie::Hash::DataSection'; + is($tie{'foo.txt'}, "bar\n"); + is(exists $tie{'foo.txt'}, 1); + is(exists $tie{'bar.txt'}, ''); + is dies { $tie{x} = 1 }, match qr/^hash is read-only/, 'exception'; + is dies { delete $tie{x} }, match qr/^hash is read-only/, 'exception'; + is [keys %tie], bag { item 'foo.txt'; item 'foo.bin'; end; }; +}; + +subtest 'plugin' => sub { + tie my %tie, 'Tie::Hash::DataSection', __PACKAGE__, 'trim'; + is($tie{'foo.txt'}, "bar"); +}; + +subtest 'plugin with args' => sub { + tie my %tie, 'Tie::Hash::DataSection', __PACKAGE__, ['trim', extensions => ['bin']]; + is($tie{'foo.txt'}, "bar\n"); + is($tie{'foo.bin'}, "bar"); +}; done_testing; + +__DATA__ + +@@ foo.txt +bar +@@ foo.bin +bar +__END__