Directory-Scratch-Structured-0.04/0000755000076400001440000000000011122302312016126 5ustar nadimusersDirectory-Scratch-Structured-0.04/t/0000755000076400001440000000000011122302312016371 5ustar nadimusersDirectory-Scratch-Structured-0.04/t/001_0_load.t0000555000076400001440000000042311122302312020274 0ustar nadimusers # test module loading use strict ; use warnings ; use Test::NoWarnings ; use Test::More qw(no_plan); use Test::Exception ; BEGIN { use_ok( 'Directory::Scratch::Structured', qw(create_structured_tree piggyback_directory_scratch) ) or BAIL_OUT("Can't load module"); } ; Directory-Scratch-Structured-0.04/t/004_create.t0000555000076400001440000000245211122302312020410 0ustar nadimusers# test use strict ; use warnings ; use Test::Exception ; use Test::Warn; use Test::NoWarnings ; use Test::More 'no_plan'; use Test::Block qw($Plan); use Directory::Scratch::Structured qw(create_structured_tree piggyback_directory_scratch) ; my %tree_structure = ( file_0 => [] , dir_1 => { subdir_1 =>{}, file_1 =>[], file_a => [], }, dir_2 => { subdir_2 => { file_22 =>[], file_2a =>[], }, file_2 =>[], file_a =>['12345'], file_b =>[], }, ) ; my $base ; { local $Plan = {'non OO interface' => 5} ; my $temporary_directory = create_structured_tree(%tree_structure) ; $base = $temporary_directory->base() ; ok(-e "$base/file_0", "file created") ; ok(-e "$base/dir_1", "directory created") ; ok(-e "$base/dir_1/subdir_1", "sub directory created") ; ok(-e "$base/dir_1/file_1", "directory file created") ; is(-s "$base/dir_2/file_a", 6, "sub directory file size ok") ; } { local $Plan = {'OO interface' => 5} ; my $scratch = Directory::Scratch->new; $scratch->create_structured_tree(%tree_structure) ; ok(-e "$base/file_0", "file created") ; ok(-e "$base/dir_1", "directory created") ; ok(-e "$base/dir_1/subdir_1", "sub directory created") ; ok(-e "$base/dir_1/file_1", "directory file created") ; is(-s "$base/dir_2/file_a", 6, "sub directory file size ok") ; } Directory-Scratch-Structured-0.04/t/005_bad_arguments.t0000555000076400001440000000062711122302312021763 0ustar nadimusers# test use strict ; use warnings ; use Test::Exception ; use Test::Warn; use Test::NoWarnings ; use Test::More 'no_plan'; use Test::Block qw($Plan); use Directory::Scratch::Structured qw(create_structured_tree) ; { local $Plan = {'non OO interface' => 1} ; throws_ok { create_structured_tree('file_0' => 'error') ; } qr[\Qinvalid element './file_0' in tree structure], "bad argument caught" ; } Directory-Scratch-Structured-0.04/t/001_1_load.t0000555000076400001440000000063411122302312020301 0ustar nadimusers # test module loading use strict ; use warnings ; use Test::NoWarnings ; use Test::More qw(no_plan); use Test::Exception ; use Test::Block qw($Plan); BEGIN { use_ok( 'Directory::Scratch::Structured' ) or BAIL_OUT("Can't load module"); } ; { local $Plan = {'piggyback' => 1} ; my $object = new Directory::Scratch ; ok(! UNIVERSAL::can($object, 'create_structured_tree'), "no piggybacking by default") ; } Directory-Scratch-Structured-0.04/lib/0000755000076400001440000000000011122302312016674 5ustar nadimusersDirectory-Scratch-Structured-0.04/lib/Directory/0000755000076400001440000000000011122302312020640 5ustar nadimusersDirectory-Scratch-Structured-0.04/lib/Directory/Scratch/0000755000076400001440000000000011122302312022227 5ustar nadimusersDirectory-Scratch-Structured-0.04/lib/Directory/Scratch/Structured.pm0000555000076400001440000001435411122302312024741 0ustar nadimusers package Directory::Scratch::Structured ; use strict; use warnings ; BEGIN { use Sub::Exporter -setup => { exports => [ qw(create_structured_tree), piggyback_directory_scratch => \&piggyback ] } ; use Sub::Install ; use vars qw ($VERSION); $VERSION = '0.04'; } #------------------------------------------------------------------------------- use English qw( -no_match_vars ) ; use Readonly ; Readonly my $EMPTY_STRING => q{} ; Readonly my $ROOT_DIRECTORY => q{.} ; use Carp qw(carp croak confess) ; use Directory::Scratch ; #------------------------------------------------------------------------------- =head1 NAME Directory::Scratch::Structured - creates temporary files and directories from a structured description =head1 SYNOPSIS my %tree_structure = ( dir_1 => { subdir_1 =>{}, file_1 =>[], file_a => [], }, dir_2 => { subdir_2 => { file_22 =>[], file_2a =>[], }, file_2 =>[], file_a =>['12345'], file_b =>[], }, file_0 => [] , ) ; use Directory::Scratch::Structured qw(create_structured_tree) ; my $temporary_directory = create_structured_tree(%tree_structure) ; or use Directory::Scratch ; use Directory::Scratch::Structured qw(piggyback_directory_scratch) ; my $temporary_directory = Directory::Scratch->new; $temporary_directory->create_structured_tree(%tree_structure) ; =head1 DESCRIPTION This module adds a I subroutine to the L. =head1 DOCUMENTATION I needed a subroutine to create a bunch of temporary directories and files while running tests. I used the excellent L to implement such a functionality. I proposed the subroutine to the L author but he preferred to implement a subroutine using an unstructured input data based on the fact that L didn't use structured data. This is, IMHO, flawed design, though it may require slightly less typing. I proposed a hybrid solution to reduce the amount of subroutines and integrate the subroutine using structured input into L but we didn't reach an agreement on the API. Instead I decided that I would piggyback on L. You can access I through a subroutine or a method through a L object. Whichever interface you choose, the argument to the I consists of tuples (hash entries). The key represents the name of the object to create in the directory. If the value is of type: =over 2 =item ARRAY A file will be created, it's contents are the contents of the array (See L) =item HASH A directory will be created. the element of the hash will also be , recursively, created =item OTHER The subroutine will croak. =back =head1 SUBROUTINES/METHODS =cut #------------------------------------------------------------------------------- sub create_structured_tree { =head2 create_structured_tree use Directory::Scratch::Structured qw(create_structured_tree) ; my $temporary_directory = create_structured_tree(%tree_structure) ; my $base = $temporary_directory->base() ; Returns a default L object. =cut my (%directory_entries) = @_ ; my $temporary_directory = new Directory::Scratch() ; _create_structured_tree($temporary_directory, \%directory_entries, $ROOT_DIRECTORY) ; return($temporary_directory ) ; } #------------------------------------------------------------------------------- sub directory_scratch_create_structured_tree { =head2 directory_scratch_create_structured_tree Adds I to L when you Load B with the B option. use Directory::Scratch ; use Directory::Scratch::Structured qw(piggyback_directory_scratch) ; my $temporary_directory = Directory::Scratch->new; $temporary_directory->create_structured_tree(%tree_structure) ; =cut my ($temporary_directory, @directory_entries) = @_ ; Directory::Scratch::Structured::_create_structured_tree($temporary_directory, {@directory_entries}, $ROOT_DIRECTORY) ; ## no critic return($temporary_directory) ; } #------------------------------------------------------------------------------- sub _create_structured_tree { =head2 _create_structured_tree Used internally by both interfaces =cut my ($temporary_directory, $directory, $path) = @_ ; while( my ($entry_name, $contents) = each %{$directory}) { for($contents) { 'ARRAY' eq ref $_ and do { my $file = $temporary_directory->touch("$path/$entry_name", @{$contents}) ; last ; } ; 'HASH' eq ref $_ and do { $temporary_directory->mkdir("$path/$entry_name"); _create_structured_tree($temporary_directory, $contents, "$path/$entry_name") ; last ; } ; croak "invalid element '$path/$entry_name' in tree structure\n" ; } } return(1) ; } #------------------------------------------------------------------------------- sub piggyback { =head2 piggyback Used internally to piggyback L. =cut Sub::Install::install_sub({ code => \&directory_scratch_create_structured_tree, into => 'Directory::Scratch', as => 'create_structured_tree', }); return('Directory::Scratch::create_structured_tree') ; } #------------------------------------------------------------------------------- 1 ; =head1 BUGS AND LIMITATIONS None so far. =head1 AUTHOR Khemir Nadim ibn Hamouda CPAN ID: NKH mailto:nadim@khemir.net =head1 LICENSE AND COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Directory::Scratch::Structured You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * RT: CPAN's request tracker Please report any bugs or feature requests to L . We will be notified, and then you'll automatically be notified of progress on your bug as we make changes. =item * Search CPAN L =back =head1 SEE ALSO L =cut Directory-Scratch-Structured-0.04/README0000555000076400001440000000034611122302312017012 0ustar nadimusersStructured ========== creates temporary files and directories from a structured description INSTALLATION ------------ To install this module type the following: perl Build.PL ./Build ./Build test ./Build install Directory-Scratch-Structured-0.04/Changes0000555000076400001440000000026511122302312017425 0ustar nadimusers0.04 CHANGED: move tests to xt/author CHANGED: simplified Build.PL 0.03 CHANGED: removed POD::Spelling and replaced with a Perl::Critic policy 0.02 FIXED: error in Build.PL Directory-Scratch-Structured-0.04/Todo.txt0000555000076400001440000000000011122302312017563 0ustar nadimusersDirectory-Scratch-Structured-0.04/Build.PL0000555000076400001440000000317011122302312017424 0ustar nadimusers use strict ; use warnings ; use Module::Build; my %all_modules ; my @split_modules ; my @pm_files = qw( lib/Directory/Scratch//Structured.pm ); for(@pm_files) { $all_modules{$_} = $_ ; push @split_modules, $_ ; } sub GetVersionAndRevisionFrom { my ($file) = @_ ; my $version_from = File::Spec->catfile( split '/', $file ); my $version = Module::Build->version_from_file($version_from); return($version) ; } my $code = <<'EOC' sub GetVersionAndRevisionFrom { my ($file) = @_ ; my $version_from = File::Spec->catfile( split '/', $file ); my $version = Module::Build->version_from_file($version_from); return($version) ; } sub ACTION_author_test { my $self = shift; local $self->{properties}{test_files} = 'xt/author/*.t' ; $self->SUPER::ACTION_test(); } EOC ; my $class = Module::Build->subclass(class => 'Directory::Scratch::Structured', code => $code) ; my $build = $class->new ( module_name => 'Directory::Scratch::Structured', dist_version => GetVersionAndRevisionFrom('lib/Directory/Scratch/Structured.pm'), license => 'perl', requires => { 'Readonly' => 0, 'Sub::Exporter' => 0, 'Sub::Install' => 0, 'Data::TreeDumper' => 0, 'Directory::Scratch' => 0, 'Test::Block' => 0, 'Test::Exception' => 0, 'Test::NoWarnings' => 0, 'Test::Warn' => 0, 'Test::Strict' => 0, }, pm_files => \%all_modules, autosplit => \@split_modules, #~ script_files => 'script/xxx.pl', dist_author => 'Khemir Nadim ibn Hamouda. ', dist_abstract => 'creates temporary files and directories from a structured description', ); $build->create_build_script; Directory-Scratch-Structured-0.04/Makefile.PL0000555000076400001440000000023211122302312020076 0ustar nadimusers use strict ; use warnings ; use Module::Build::Compat; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(); Directory-Scratch-Structured-0.04/META.yml0000444000076400001440000000127311122302312017400 0ustar nadimusers--- name: Directory-Scratch-Structured version: 0.04 author: - 'Khemir Nadim ibn Hamouda. ' abstract: creates temporary files and directories from a structured description license: perl resources: license: http://dev.perl.org/licenses/ requires: Data::TreeDumper: 0 Directory::Scratch: 0 Readonly: 0 Sub::Exporter: 0 Sub::Install: 0 Test::Block: 0 Test::Exception: 0 Test::NoWarnings: 0 Test::Strict: 0 Test::Warn: 0 provides: Directory::Scratch::Structured: file: lib/Directory/Scratch/Structured.pm version: 0.04 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Directory-Scratch-Structured-0.04/MANIFEST0000555000076400001440000000025711122302312017264 0ustar nadimusersChanges Build.PL Makefile.PL MANIFEST README META.yml README Todo.txt lib/Directory/Scratch/Structured.pm t/001_0_load.t t/001_1_load.t t/004_create.t t/005_bad_arguments.t