Elive::Util - Utility functions for Elive

Elive documentation Contained in the Elive distribution.

Index

Code Index:

NAME

Top

Elive::Util - Utility functions for Elive

METHODS

Top

inspect_type

       $type = Elive::Util::inspect_type($att->type_constraint)
       @coerce_types = Elive::Util::inspect_type($att->type_constraint, $data)

Parses an entity property type and returns an elemental coercement type.

prompt

    my $password = Elive::Util::prompt('Password: ', password => 1)

Prompt for user input

string

    print Elive::Util::string($myscalar);
    print Elive::Util::string($myobj);
    print Elive::Util::string($myref, $datatype);

Return a string for an object. This method is widely used for casting objects to ids.

If it's a simple scalar, just pass the value back.

If it's an object use the stringify method.

If it's a reference, resolve datatype to a class, and use its stringify method.

next_quarter_hour

Quarter hour advancement for the Time Module impoverished.

    my $start = Elive::Util::next_quarter_hour();
    my $end = Elive::Util::next_quarter_hour($start);

Advance to the next quarter hour without the use of any supporting time modules. We just simply increment in seconds until localtime indicates that we're exactly on a quarter hour and ahead of the start time.

A small initial increment is added to ensure that the date remains in the future, allowing for minor gotchas such as leap seconds, general latency and smallish time drifts between the client and server.

Elive documentation Contained in the Elive distribution. 
package Elive::Util;
use warnings; use strict;

use Term::ReadKey;
use Term::ReadLine;
use IO::Interactive;
use Scalar::Util;
use Storable;
use YAML;

use Elive::Util::Type;


sub inspect_type {
    my $type_union = shift;

    my @types = split(/\|/, $type_union);

    return Elive::Util::Type->new($types[0])
}

sub _freeze {
    my ($val, $type) = @_;

    for ($val) {

	if (!defined) {

	    warn "undefined value of type $type\n"
	}
	else {
	    $_ = string($_, $type);
	    my $raw_val = $_;

	    if ($type =~ m{^Bool}ix) {

		#
		# DBize boolean flags..
		#
		$_ =  $_ ? 'true' : 'false';
	    }
	    elsif ($type =~ m{^(Str|enum)}ix) {
		#
		# l-r trim
		#
		s{^ \s* (.*?) \s* $}{$1}x;
		$_ = lc if $type =~ m{^enum};
	    }
	    elsif ($type =~ m{^(Int|HiResDate)}ix) {
		
		$_ = _tidy_decimal($_);
		
	    }
	    elsif ($type =~ m{^Ref}ix) {
		$val = undef;
	    }
	    else {
		die "unable to convert $raw_val to $type\n"
		    unless defined;
	    }
	}
    }

    return $val;
}

#
# thawing of elementry datatypes
#

sub _thaw {
    my ($val, $type) = @_;

    return $val if $type =~ m{Ref}i
	|| ref( $val);

    return unless defined $val;

    for ($val) {
	if ($type =~ m{^Bool}i) {
	    #
	    # Perlise boolean flags..
	    #
	    $_ = m{^(true|1)$}i ? 1 : 0;
	}
	elsif ($type =~ m{^(Str|enum)}i) {
	    #
	    # l-r trim
	    #
	    s{^ \s* (.*?) \s* $}{$1}x;
	    $_ = lc if $type =~ m{^enum}i;
	}
	elsif ($type =~ m{^Int|HiResDate}i) {

	    $_ = _tidy_decimal($_);

	}
	else {
	    die "unknown type: $type";
	}
    }

    return $val;
}


#
# _tidy_decimal(): general cleanup and normalisation of an integer.
#               used to clean up numbers for data storage or comparison

sub _tidy_decimal {
    my $i = shift;;
    #
    # well a number really. don't convert or sprintf etc
    # to avoid overflow. Just normalise it for potential
    # string comparisons

    #
    # l-r trim
    #
    $i =~ s{^ \s* (.*?) \s* $}{$1}x;

    #
    # non number => undef
    #
    return
	unless $i =~ m{^[+-]?\d+$};

    #
    # remove any leading zeros:
    # +000123 => 123
    # -00045 => -45
    # -000 => 0
    #

    $i =~ s{^
                        \+?    # leading plus -discarded 
                        (-?)   # leading minus retained (usually)
                        0*     # leading zeros discarded
                        (\d+?) # number - retained
                        $}
	    	    {$1$2}x;

    #
    # reduce -0 => 0
    $i = 0 if ($i eq '-0');

    #
    # sanity check.
    #
    die "bad integer: $_[0]"
	unless $i =~ m{^[+-]?\d+$};

    return $i;
}


sub prompt {
    my ($prompt,%opt) = @_;

    chomp($prompt ||= 'input:');

    ReadMode $opt{password}? 2: 1; # Turn off controls keys

    my $input;
    my $n = 0;

    do {
	die "giving up on input of $prompt" if ++$n > 100;
	print $prompt if IO::Interactive::is_interactive();
	$input = ReadLine(0);
	return
	    unless (defined $input);
	chomp($input);
    } until (defined($input) && length($input));

    ReadMode 0; # Reset tty mode before exiting

    return $input;
}

sub _reftype {
    return Scalar::Util::reftype( shift() ) || '';
}

sub _clone {
    return Storable::dclone(shift);
}

#
# Hex encoding/decoding. Use for data streaming. E.g. upload & download
# of preload data.
#

sub _hex_decode {
    my $data = shift;

    return
	unless defined $data;

    $data = '0'.$data
	unless length($data) % 2 == 0;

    my ($non_hex_char) = ($data =~ m{([^0-9a-f])}ix);

    die "non hex character in data: ".$non_hex_char
	if (defined $non_hex_char);
    #
    # Works for simple ascii
    $data =~ s{(..)}{chr(hex($1))}gex;

    return $data;
}

sub _hex_encode {
    my $data = shift;

    $data =~ s{(.)}{sprintf("%02x", ord($1))}gesx;

    return $data;
}


sub string {
    my $obj = shift;
    my $data_type = shift;

    for ($obj) {

	if ($data_type) {
	    my ($dt) = ($data_type =~ m{(.*)});

	    return $dt->stringify($_)
		if eval{$dt->can('stringify')};
	}

	my $reftype =  _reftype($_);

	return $_
	    unless $reftype;

	return $_->stringify
	    if (Scalar::Util::blessed($_) && $_->can('stringify'));

	if ($reftype eq 'ARRAY') {
	    return join(',', map {string($_ => $data_type)} @$_)
	}
    }

    #
    # Nothing else worked; dump it.
    #
    return YAML::Dump($obj);
}


sub next_quarter_hour {
    my $time = shift || time();

    $time += 30;

    for (;;) {
	my @t = localtime(++$time);
	my $sec = $t[0];
	my $min = $t[1];

	last unless $min % 15 || $sec;
    }

    return $time;
}

1;