/ 
Hades-0.23
River stage one • 5 direct dependents • 9 total dependents
/ Hades

NAME

Hades - Less is more, more is less!

VERSION

Version 0.23

SYNOPSIS

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__

SUBROUTINES/METHODS

run

file

Provide a file to read in.

eval

Provide a string to eval.

verbose

Set verbose to true, to print build steps to STDOUT.

debug

Set debug to true, to step through the build.

dist

Provide a name for the distribution.

lib

Provide a path where the generated files will be compiled.

tlib

Provide a path where the generates test files will be compiled.

author

The author of the distribution/module.

email

The authors email of the distribution/module.

version

The version number of the distribution/module.

realm

The Hades realm that is used to generate the code.

Hades

Class

Declare a new class.

Kosmos {

}

Abstract

Declare the classes Abstract.

Kosmos {
	abstract { Afti einai i perilipsi }
}

Synopsis

Declare the classes Synopsis.

Kosmos {
	synopsis {
		Schetika me ton Kosmos

			Kosmos->new;
	}
}

Inheritance

base

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 {

}

parent

Establish an ISA relationship with base classes at compile time.

Kosmos parent Kato {

}

require

Require library files to be included if they have not already been included.

Kosmos require Kato {

}

use

Declare modules that should be included in the class.

Kosmos use Kato Vathys {

}

Test

Declare the classes additional tests.

Kosmos {
	test {
		[
			['ok', 'my $obj = Kosmos->new'],
			['is', '$obj->dokimi', undef]
		]
	}
}

Compile phase

begin

Define a code block is executed as soon as possible.

Kosmos {
	begin {
		... perl code ...
	}
}

unitcheck

Define a code block that is executed just after the unit which defined them has been compiled.

Kosmos {
	unitcheck {
		... perl code ...
	}
}

check

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 ...
	}
}

init

Define a code block that is executed just before the Perl runtime begins execution.

Kosmos {
	init {
		... perl code ...
	}
}

end

Define a code block is executed as late as possible.

Kosmos {
	end {
		... perl code ...
	}
}

Variables

our

Declare variable of the same name in the current package for use within the lexical scope.

Kosmos {
	our $one %two
}

Accessors

Declare an accessor for the class

Kosmos {
	dokimi
	dokimes
}

:required | :r

Making an accessor required means a value for the accessor must be supplied to the constructor.

dokimi :r
dokimes :required

:default | :d

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/] }])

:clearer | :c

Setting clearer creates a method to clear the accessor.

dokimi :c
dokimes :clearer

$class->clear_dokimi;

:coerce | :co

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";)

:private | :p

Setting private makes the accessor only available to the class.

dokimi :p
dokimes :private

:predicate | :pr

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

:trigger | :tr

Takes a coderef which will get called any time the attribute is set.

dokimi :tr(trigger_to_method)
dokimes :trigger(warn Dumper $value)

:type | :t

Add type checking to the accessor.

dokimi :t(Dict[onoma => Str, id => Optional[Int], epiloges => Dict[onama => Str]])
dokimes :type(Str)

:builder | :bdr

Takes a coderef which is meant to build the attributes value.

dokimi :bdr
dokimes :builder($value = $value->[0] if ref($value) || "" eq "ARRAY";)

:test | :z

Add tests associated to the accessor.

dokimi :z(['ok', '$obj->dokimi'])
dokimes :z(['deep', '$obj->dokimes({})', q|{}|)

Methods

Declare a sub routine/method.

Kosmos {
	dokimi {
		... perl code ...
	}
}

Params

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 ...
}

:type :t

Add type checking to the param.

dokimi $one :t(Str) {
	... perl code ...
}

dokimes $one :t(Str) $two :t(HashRef) {
	... perl code ...
}

:coerce | :co

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)

:private :p

Setting private makes the method only available to the class.

dokimi :p {
	... perl code ...
}
dokimes :private $one %two {
	... perl code ...
}

:default | :d

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/] }]) { }

:test | :z

Add tests associated to the sub.

dokimi :z(['ok', '$obj->dokimi']) { }
dokimes :test(['deep', '$obj->dokimes({})', q|{}|) { }

:before | :b

Before is called before the parent method is called. You can modify the params using the @params variable.

dokimi :b {
	... before ...
}:

generates

	sub dokimi {
		my ( $orig, $self, @params ) = ( 'SUPER::geras', @_ );
		... before ...
		my @res = $self->$orig(@params);
        	return @res;
	}

:around | :ar

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 ...
}

generates

	sub dokimi {
		my ( $orig, $self, @params ) = ( 'SUPER::geras', @_ );
		... before around ...
		my @res = $self->$orig(@params);
		... after around ...
        	return @res;
	}

:after | :a

After is called after the parent method is called. You can modify the response using the @res variable.

dokimi :a {
	... after ...
}

generates

sub dokimi {
	my ( $orig, $self, @params ) = ( 'SUPER::geras', @_ );
	my @res = $self->$orig(@params);
	... after ...
	return @res;
}

Types

Any

Absolutely any value passes this type constraint (even undef).

dokimi :t(Any)

Item

Essentially the same as Any. All other type constraints in this library inherit directly or indirectly from Item.

dokimi :t(Item)

Bool

Values that are reasonable booleans. Accepts 1, 0, the empty string and undef.

dokimi :t(Bool)

Str

Any string.

dokimi :t(Str)

Num

Any number.

dokimi :t(Num)

Int

An integer; that is a string of digits 0 to 9, optionally prefixed with a hyphen-minus character.

dokimi :t(Int)

Ref

Any defined reference value, including blessed objects.

dokimi :t(Ref)
dokimes :t(Ref[HASH])

ScalarRef

A value where ref($value) eq "SCALAR" or ref($value) eq "REF".

dokimi :t(ScalarRef)
dokimes :t(ScalarRef[SCALAR])

ArrayRef

A value where ref($value) eq "ARRAY".

dokimi :t(ArrayRef)
dokimes :t(ArrayRef[Str, 1, 100])

HashRef

A value where ref($value) eq "HASH".

dokimi :t(HashRef)
dokimes :t(HashRef[Int])

CodeRef

A value where ref($value) eq "CODE"

dokimi :t(CodeRef)

RegexpRef

A value where ref($value) eq "Regexp"

dokimi :t(RegexpRef)

GlobRef

A value where ref($value) eq "GLOB"

dokimi :t(GlobRef)

Object

A blessed object.

dokimi :t(Object)

Map

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])

Tuple

Accepting a list of type constraints for each slot in the array.

dokimi :t(Tuple[Str, Int, HashRef])

Dict

Accepting a list of type constraints for each slot in the hash.

dokimi :t(Dict[onoma => Str, id => Optional[Int], epiloges => Dict[onama => Str]])

Optional

Used in conjunction with Dict and Tuple to specify slots that are optional and may be omitted.

dokimi :t(Optional[Str])

Macros

Hades has a concept of macros that allow you to write re-usable code. see https://metacpan.org/source/LNATION/Hades-0.23/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__

Testing

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
------------------- ------ ------ ------ ------ ------ ------

tests

Unfortunately not all code can have auto generated tests, so you should use the :test attribute to define additional to test custom logic.

ok

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']

can_ok

Checks to make sure the $module or $object can do these @methods (works with functions, too).

['can_ok', '$obj', $method]

isa_ok

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]

is

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

['isnt', '$obj->$method', $expected]

like

Similar to ok(), like() matches $got against the regex qr/expected/.

['like', '$obj->$method', $expected_regex]

unlike

Works exactly as like(), only it checks if $got does not match the given pattern.

['unlike', '$obj->$method', $expected_regex]

deep

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]

eval

Evaluate code that you expect to die and check the warning using like.

['eval', '$obj->$method", $error_expected]

AUTHOR

LNATION, <email at lnation.org>

BUGS

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.

SUPPORT

You can find documentation for this module with the perldoc command.

perldoc Hades

You can also look for information at:

ACKNOWLEDGEMENTS

LICENSE AND COPYRIGHT

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:

Around line 1339:

Non-ASCII character seen before =encoding in '(£penthos'. Assuming UTF-8