Hades - Less is more, more is less!
Version 0.21
use Hades; Hades->run({ eval => q| Kosmos { [penthos curae] :t(Int) :d(2) :p :pr :c :r geras $nosoi :t(Int) :d(2) { if (£penthos == $nosoi) { return £curae; } } } | }); ... generates ... package Kosmos; use strict; use warnings; our $VERSION = 0.01; sub new { my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ ); my $self = bless {}, $cls; my %accessors = ( penthos => { required => 1, default => 2, }, curae => { required => 1, default => 2, }, ); for my $accessor ( keys %accessors ) { my $value = $self->$accessor( defined $args{$accessor} ? $args{$accessor} : $accessors{$accessor}->{default} ); unless ( !$accessors{$accessor}->{required} || defined $value ) { die "$accessor accessor is required"; } } return $self; } sub penthos { my ( $self, $value ) = @_; my $private_caller = caller(); if ( $private_caller ne __PACKAGE__ ) { die "cannot call private method penthos from $private_caller"; } if ( defined $value ) { if ( ref $value || $value !~ m/^[-+\d]\d*$/ ) { die qq{Int: invalid value $value for accessor penthos}; } $self->{penthos} = $value; } return $self->{penthos}; } sub clear_penthos { my ($self) = @_; delete $self->{penthos}; return $self; } sub has_penthos { my ($self) = @_; return exists $self->{penthos}; } sub curae { my ( $self, $value ) = @_; my $private_caller = caller(); if ( $private_caller ne __PACKAGE__ ) { die "cannot call private method curae from $private_caller"; } if ( defined $value ) { if ( ref $value || $value !~ m/^[-+\d]\d*$/ ) { die qq{Int: invalid value $value for accessor curae}; } $self->{curae} = $value; } return $self->{curae}; } sub clear_curae { my ($self) = @_; delete $self->{curae}; return $self; } sub has_curae { my ($self) = @_; return exists $self->{curae}; } sub geras { my ( $self, $nosoi ) = @_; $nosoi = defined $nosoi ? $nosoi : 5; if ( !defined($nosoi) || ref $nosoi || $nosoi !~ m/^[-+\d]\d*$/ ) { $nosoi = defined $nosoi ? $nosoi : 'undef'; die qq{Int: invalid value $nosoi for variable \$nosoi in method geras}; } if ( $self->penthos == $nosoi ) { return $self->curae; } } 1; __END__
Provide a file to read in.
Provide a string to eval.
Set verbose to true, to print build steps to STDOUT.
Set debug to true, to step through the build.
Provide a name for the distribution.
Provide a path where the generated files will be compiled.
Provide a path where the generates test files will be compiled.
The author of the distribution/module.
The authors email of the distribution/module.
The version number of the distribution/module.
The Hades realm that is used to generate the code.
Declare a new class.
Kosmos { }
Declare the classes Abstract.
Kosmos { abstract { Afti einai i perilipsi } }
Declare the classes Synopsis.
Kosmos { synopsis { Schetika me ton Kosmos Kosmos->new; } }
Establish an ISA relationship with base classes at compile time.
Unless you are using the fields pragma, consider this discouraged in favor of the lighter-weight parent.
Kosmos base Kato { }
Kosmos parent Kato { }
Require library files to be included if they have not already been included.
Kosmos require Kato { }
Declare modules that should be included in the class.
Kosmos use Kato Vathys { }
Declare the classes additional tests.
Kosmos { test { [ ['ok', 'my $obj = Kosmos->new'], ['is', '$obj->dokimi', undef] ] } }
Define a code block is executed as soon as possible.
Kosmos { begin { ... perl code ... } }
Define a code block that is executed just after the unit which defined them has been compiled.
Kosmos { unitcheck { ... perl code ... } }
Define a code block that is executed just after the initial Perl compile phase ends and before the run time begins.
Kosmos { check { ... perl code ... } }
Define a code block that is executed just before the Perl runtime begins execution.
Kosmos { init { ... perl code ... } }
Define a code block is executed as late as possible.
Kosmos { end { ... perl code ... } }
Declare variable of the same name in the current package for use within the lexical scope.
Kosmos { our $one %two }
Declare an accessor for the class
Kosmos { dokimi dokimes }
Making an accessor required means a value for the accessor must be supplied to the constructor.
dokimi :r dokimes :required
The default is used when no value for the accessor was supplied to the constructor.
dokimi :d(Eimai o monos) dokimes :default([{ ola => "peripou", o => [qw/kosmos/] }])
Setting clearer creates a method to clear the accessor.
dokimi :c dokimes :clearer $class->clear_dokimi;
Takes a coderef which is meant to coerce the attributes value.
dokimi :co(array_to_string) dokimes :coerce($value = $value->[0] if ref($value) || "" eq "ARRAY";)
Setting private makes the accessor only available to the class.
dokimi :p dokimes :private
Takes a method name which will return true if an attribute has a value. The predicate is automatically named has_${accessor}.
dokimi :pr dokimes :predicate
Takes a coderef which will get called any time the attribute is set.
dokimi :tr(trigger_to_method) dokimes :trigger(warn Dumper $value)
Add type checking to the accessor.
dokimi :t(Dict[onoma => Str, id => Optional[Int], epiloges => Dict[onama => Str]]) dokimes :type(Str)
Takes a coderef which is meant to build the attributes value.
dokimi :bdr dokimes :builder($value = $value->[0] if ref($value) || "" eq "ARRAY";)
Add tests associated to the accessor.
dokimi :z(['ok', '$obj->dokimi']) dokimes :z(['deep', '$obj->dokimes({})', q|{}|)
Declare a sub routine/method.
Kosmos { dokimi { ... perl code ... } }
Methods will always have $self defined but you can define additional params by declaring them before the code block.
dokimi $one %two { ... perl code ... }
generates
sub dokimi { my ($self, $one, %two) = @_; ... perl code ... }
Add type checking to the param.
dokimi $one :t(Str) { ... perl code ... } dokimes $one :t(Str) $two :t(HashRef) { ... perl code ... }
Takes a coderef which is meant to coerce the method param.
dokimi $str :co(array_to_string) dokimes $str :t(Str) :co(array_to_string)
Setting private makes the method only available to the class.
dokimi :p { ... perl code ... } dokimes :private $one %two { ... perl code ... }
The default is used when no value for the sub was passed as a param.
dokimi $str :d(Eimai o monos) { } dokimes $arrayRef :default([{ ola => "peripou", o => [qw/kosmos/] }]) { }
Add tests associated to the sub.
dokimi :z(['ok', '$obj->dokimi']) { } dokimes :test(['deep', '$obj->dokimes({})', q|{}|) { }
Before is called before the parent method is called. You can modify the params using the @params variable.
dokimi :b { ... before ... }:
sub dokimi { my ( $orig, $self, @params ) = ( 'SUPER::geras', @_ ); ... before ... my @res = $self->$orig(@params); return @res; }
Around is called instead of the method it is modifying. The method you're overriding is passed in as the first argument (called $orig by convention). You can modify the params using the @params variable.
dokimi :ar { ... before around ... my @res = $self->$orig(@params); ... after around ... }
sub dokimi { my ( $orig, $self, @params ) = ( 'SUPER::geras', @_ ); ... before around ... my @res = $self->$orig(@params); ... after around ... return @res; }
After is called after the parent method is called. You can modify the response using the @res variable.
dokimi :a { ... after ... }
sub dokimi { my ( $orig, $self, @params ) = ( 'SUPER::geras', @_ ); my @res = $self->$orig(@params); ... after ... return @res; }
Absolutely any value passes this type constraint (even undef).
dokimi :t(Any)
Essentially the same as Any. All other type constraints in this library inherit directly or indirectly from Item.
dokimi :t(Item)
Values that are reasonable booleans. Accepts 1, 0, the empty string and undef.
dokimi :t(Bool)
Any string.
dokimi :t(Str)
Any number.
dokimi :t(Num)
An integer; that is a string of digits 0 to 9, optionally prefixed with a hyphen-minus character.
dokimi :t(Int)
Any defined reference value, including blessed objects.
dokimi :t(Ref) dokimes :t(Ref[HASH])
A value where ref($value) eq "SCALAR" or ref($value) eq "REF".
dokimi :t(ScalarRef) dokimes :t(ScalarRef[SCALAR])
A value where ref($value) eq "ARRAY".
dokimi :t(ArrayRef) dokimes :t(ArrayRef[Str, 1, 100])
A value where ref($value) eq "HASH".
dokimi :t(HashRef) dokimes :t(HashRef[Int])
A value where ref($value) eq "CODE"
dokimi :t(CodeRef)
A value where ref($value) eq "Regexp"
dokimi :t(RegexpRef)
A value where ref($value) eq "GLOB"
dokimi :t(GlobRef)
A blessed object.
dokimi :t(Object)
Similar to HashRef but parameterized with type constraints for both the key and value. The constraint for keys would typically be a subtype of Str.
dokimi :t(Map[Str, Int])
Accepting a list of type constraints for each slot in the array.
dokimi :t(Tuple[Str, Int, HashRef])
Accepting a list of type constraints for each slot in the hash.
dokimi :t(Dict[onoma => Str, id => Optional[Int], epiloges => Dict[onama => Str]])
Used in conjunction with Dict and Tuple to specify slots that are optional and may be omitted.
dokimi :t(Optional[Str])
Hades has a concept of macros that allow you to write re-usable code. see https://metacpan.org/source/LNATION/Hades-0.21/macro-fh.hades for an example of how to extend via macros.
macro { FH [ macro => [qw/read_file write_file/], alias => { read_file => [qw/rf/], write_file => [qw/wf/] } ] str2ArrayRef :a(s2ar) { return qq|$params[0] = [ $params[0] ];|; } ArrayRef2Str :a(ar2s) { return qq|$params[0] = $params[0]\->[0];|; } } MacroKosmos { eros $eros :t(Str) :d(t/test.txt) { €s2ar('$eros'); €ar2s('$eros'); €wf('$eros', q|'this is a test'|); return $eros; } psyche $psyche :t(Str) :d(t/test.txt) { €rf('$psyche'); return $content; } } ... generates ... package MacroKosmos; use strict; use warnings; our $VERSION = 0.01; sub new { my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ ); my $self = bless {}, $cls; my %accessors = (); for my $accessor ( keys %accessors ) { my $value = $self->$accessor( defined $args{$accessor} ? $args{$accessor} : $accessors{$accessor}->{default} ); unless ( !$accessors{$accessor}->{required} || defined $value ) { die "$accessor accessor is required"; } } return $self; } sub eros { my ( $self, $eros ) = @_; $eros = defined $eros ? $eros : "t/test.txt"; if ( !defined($eros) || ref $eros ) { $eros = defined $eros ? $eros : 'undef'; die qq{Str: invalid value $eros for variable \$eros in method eros}; } $eros = [$eros]; $eros = $eros->[0]; open my $wh, ">", $eros or die "cannot open file for writing: $!"; print $wh 'this is a test'; close $wh; return $eros; } sub psyche { my ( $self, $psyche ) = @_; $psyche = defined $psyche ? $psyche : "t/test.txt"; if ( !defined($psyche) || ref $psyche ) { $psyche = defined $psyche ? $psyche : 'undef'; die qq{Str: invalid value $psyche for variable \$psyche in method psyche}; } open my $fh, "<", $psyche or die "cannot open file for reading: $!"; my $content = do { local $/; <$fh> }; close $fh; return $content; } 1; __END__
Hades can auto-generate test files. If you take the following example:
use Hades; Hades->run({ eval => q|Dokimes { curae :r :default(5) penthos :t(Str) :r nosoi :default(3) :t(Int) :clearer limos $test :t(Str) :test( ['ok', '$obj->penthos(2) && $obj->nosoi(2) && $obj->curae(5)'], ['is', '$obj->limos("yay")', 5 ], ['ok', '$obj->penthos(5)' ], ['is', '$obj->limos("yay")', q{''}] ) { if ($_[0]->penthos == $_[0]->nosoi) { return $_[0]->curae; } } }|, lib => 'lib', tlib => 't/lib', });
It will generate a test file located at t/lib/Dokimes.t which looks like:
use Test::More; use strict; use warnings; BEGIN { use_ok('Dokimes'); } subtest 'new' => sub { plan tests => 16; ok( my $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{my $obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); ok( $obj = Dokimes->new( curae => 'hypnos', penthos => 'aporia' ), q{$obj = Dokimes->new(curae => 'hypnos', penthos => 'aporia')} ); isa_ok( $obj, 'Dokimes' ); ok( $obj = Dokimes->new( { penthos => 'aporia', nosoi => 10 } ), q{$obj = Dokimes->new({penthos => 'aporia', nosoi => 10})} ); ok( $obj = Dokimes->new( penthos => 'aporia', nosoi => 10 ), q{$obj = Dokimes->new(penthos => 'aporia', nosoi => 10)} ); is( $obj->curae, 5, q{$obj->curae} ); ok( $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia', nosoi => 10 } ), q{$obj = Dokimes->new({ curae => 'hypnos', penthos => 'aporia', nosoi => 10 })} ); eval { $obj = Dokimes->new( { curae => 'hypnos', nosoi => 10 } ) }; like( $@, qr/required/, q{$obj = Dokimes->new({curae => 'hypnos', nosoi => 10})} ); eval { $obj = Dokimes->new( { curae => 'hypnos', penthos => [], nosoi => 10 } ); }; like( $@, qr/invalid value|greater|atleast/, q{$obj = Dokimes->new({ curae => 'hypnos', penthos => [], nosoi => 10 })} ); eval { $obj = Dokimes->new( { curae => 'hypnos', penthos => \1, nosoi => 10 } ); }; like( $@, qr/invalid value|greater|atleast/, q{$obj = Dokimes->new({ curae => 'hypnos', penthos => \1, nosoi => 10 })} ); eval { $obj = Dokimes->new( { curae => 'hypnos', penthos => '', nosoi => 10 } ); }; like( $@, qr/invalid value|greater|atleast/, q{$obj = Dokimes->new({ curae => 'hypnos', penthos => '', nosoi => 10 })} ); ok( $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{$obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); ok( $obj = Dokimes->new( curae => 'hypnos', penthos => 'aporia' ), q{$obj = Dokimes->new(curae => 'hypnos', penthos => 'aporia')} ); is( $obj->nosoi, 3, q{$obj->nosoi} ); eval { $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia', nosoi => [] } ); }; like( $@, qr/invalid value|greater|atleast/, q{$obj = Dokimes->new({ curae => 'hypnos', penthos => 'aporia', nosoi => [] })} ); eval { $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia', nosoi => 'limos' } ); }; like( $@, qr/invalid value|greater|atleast/, q{$obj = Dokimes->new({ curae => 'hypnos', penthos => 'aporia', nosoi => 'limos' })} ); }; subtest 'curae' => sub { plan tests => 2; ok( my $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{my $obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); can_ok( $obj, 'curae' ); }; subtest 'penthos' => sub { plan tests => 7; ok( my $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{my $obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); can_ok( $obj, 'penthos' ); is_deeply( $obj->penthos('curae'), 'curae', q{$obj->penthos('curae')} ); eval { $obj->penthos( [] ) }; like( $@, qr/invalid value|greater|atleast/, q{$obj->penthos([])} ); eval { $obj->penthos( \1 ) }; like( $@, qr/invalid value|greater|atleast/, q{$obj->penthos(\1)} ); eval { $obj->penthos('') }; like( $@, qr/invalid value|greater|atleast/, q{$obj->penthos('')} ); is_deeply( $obj->penthos, 'curae', q{$obj->penthos} ); }; subtest 'nosoi' => sub { plan tests => 6; ok( my $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{my $obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); can_ok( $obj, 'nosoi' ); is_deeply( $obj->nosoi(10), 10, q{$obj->nosoi(10)} ); eval { $obj->nosoi( [] ) }; like( $@, qr/invalid value|greater|atleast/, q{$obj->nosoi([])} ); eval { $obj->nosoi('phobos') }; like( $@, qr/invalid value|greater|atleast/, q{$obj->nosoi('phobos')} ); is_deeply( $obj->nosoi, 10, q{$obj->nosoi} ); }; subtest 'limos' => sub { plan tests => 10; ok( my $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{my $obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); can_ok( $obj, 'limos' ); eval { $obj->limos( [] ) }; like( $@, qr/invalid value|greater|atleast/, q{$obj->limos([])} ); eval { $obj->limos( \1 ) }; like( $@, qr/invalid value|greater|atleast/, q{$obj->limos(\1)} ); eval { $obj->limos('') }; like( $@, qr/invalid value|greater|atleast/, q{$obj->limos('')} ); eval { $obj->limos(undef) }; like( $@, qr/invalid value|greater|atleast/, q{$obj->limos(undef)} ); ok( $obj->penthos(2) && $obj->nosoi(2) && $obj->curae(5), q{$obj->penthos(2) && $obj->nosoi(2) && $obj->curae(5)} ); is( $obj->limos("yay"), 5, q{$obj->limos("yay")} ); ok( $obj->penthos(5), q{$obj->penthos(5)} ); is( $obj->limos("yay"), '', q{$obj->limos("yay")} ); }; subtest 'clear_nosoi' => sub { plan tests => 5; ok( my $obj = Dokimes->new( { curae => 'hypnos', penthos => 'aporia' } ), q{my $obj = Dokimes->new({curae => 'hypnos', penthos => 'aporia'})} ); can_ok( $obj, 'clear_nosoi' ); is_deeply( $obj->nosoi(10), 10, q{$obj->nosoi(10)} ); ok( $obj->clear_nosoi, q{$obj->clear_nosoi} ); is( $obj->nosoi, undef, q{$obj->nosoi} ); }; done_testing();
and has 100% test coverage.
cover --test ------------------- ------ ------ ------ ------ ------ ------ File stmt bran cond sub time total ------------------- ------ ------ ------ ------ ------ ------ blib/lib/Dokimes.pm 100.0 100.0 100.0 100.0 100.0 100.0 Total 100.0 100.0 100.0 100.0 100.0 100.0 ------------------- ------ ------ ------ ------ ------ ------
Unfortunately not all code can have auto generated tests, so you should use the :test attribute to define additional to test custom logic.
This simply evaluates any expression ($got eq $expected is just a simple example) and uses that to determine if the test succeeded or failed. A true expression passes, a false one fails.
['ok', '$obj->$method']
Checks to make sure the $module or $object can do these @methods (works with functions, too).
['can_ok', '$obj', $method]
Checks to see if the given $object->isa($class). Also checks to make sure the object was defined in the first place. Handy for this sort of thing:
['isa_ok', '$obj', $class]
Similar to ok(), is() and isnt() compare their two arguments with eq and ne respectively and use the result of that to determine if the test succeeded or failed. So these:
['is', '$obj->$method', $expected]
['isnt', '$obj->$method', $expected]
Similar to ok(), like() matches $got against the regex qr/expected/.
['like', '$obj->$method', $expected_regex]
Works exactly as like(), only it checks if $got does not match the given pattern.
['unlike', '$obj->$method', $expected_regex]
Similar to is(), except that if $got and $expected are references, it does a deep comparison walking each data structure to see if they are equivalent. If the two structures are different, it will display the place where they start differing.
['deep', '$obj->$method', $expected]
Evaluate code that you expect to die and check the warning using like.
['eval', '$obj->$method", $error_expected]
LNATION, <email at lnation.org>
<email at lnation.org>
Please report any bugs or feature requests to bug-hades at rt.cpan.org, or through the web interface at https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
bug-hades at rt.cpan.org
You can find documentation for this module with the perldoc command.
perldoc Hades
You can also look for information at:
RT: CPAN's request tracker (report bugs here)
https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades
AnnoCPAN: Annotated CPAN documentation
http://annocpan.org/dist/Hades
CPAN Ratings
https://cpanratings.perl.org/d/Hades
Search CPAN
https://metacpan.org/release/Hades
This software is Copyright (c) 2020 by LNATION.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
1 POD Error
The following errors were encountered while parsing the POD:
Non-ASCII character seen before =encoding in '(£penthos'. Assuming UTF-8
To install Hades, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Hades
CPAN shell
perl -MCPAN -e shell install Hades
For more information on module installation, please visit the detailed CPAN module installation guide.