package Lire::DataTypes;

use strict;

use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION %VALIDATORS
	     $SUPERSERVICE_RE );

# Do not use 'use Lire::Config' here because it needs some functions
# that are defined here
require Lire::Config;
use Carp;

BEGIN {
    ($VERSION)	= '$Revision: 1.26 $' =~ m!Revision: ([.\d]+)!;
    @ISA	= qw( Exporter );
    @EXPORT	= ();
    @EXPORT_OK  = ();
    %EXPORT_TAGS = ( xml    => [qw( check_xml_name check_nmtoken )],
		     basic  => [qw( check_bool check_int check_number
				    count2number number2count
				    check_string eval_bool is_numeric_type
				    is_quantity_type ) ],
		     time   => [qw( check_timestamp check_time check_date
				    check_duration duration2sec sec2duration
				    is_numeric_type is_time_type
				    weekly_duration monthly_duration
				    yearly_duration)],
		     internet => [qw( check_ip check_port check_hostname
                                    check_url check_email )],
		     misc   => [qw( check_bytes size2bytes bytes2size
				    check_filename is_numeric_type ) ],
		     special => [qw( check_superservice check_field
				     check_chart check_type
				     format_numeric_type ) ],
		   );

    foreach my $tag ( keys %EXPORT_TAGS ) {
	Exporter::export_ok_tags( $tag );
    }

};

# We don't set this at compile time, since the subs have to be defined
# first
%VALIDATORS = (
	       xml_name	=> \&check_xml_name,
	       nmtoken	=> \&check_nmtoken,

	       bool	=> \&check_bool,
	       int	=> \&check_int,
	       number	=> \&check_number,
	       string	=> \&check_string,

	       timestamp => \&check_timestamp,
	       date	=> \&check_date,
	       time	=> \&check_time,
	       duration	=> \&check_duration,

	       ip	=> \&check_ip,
               port     => \&check_port,
	       hostname	=> \&check_hostname,
	       url	=> \&check_url,
	       email	=> \&check_email,

	       bytes	=> \&check_bytes,
	       filename	=> \&check_filename,

	       type	=> \&check_type,
	       field	=> \&check_field,
	       superservice => \&check_superservice,
	       chart	=> \&check_chart,
	      );

#
# XML Types
#
sub check_xml_name {
    unless (defined $_[0]) {
        warn "check_xml_name called with undef arg\n";
        return undef;
    }
    scalar $_[0] =~ /^[_a-zA-Z][-\w:.]*$/;
}

sub check_nmtoken {
    scalar $_[0] =~ /\^[-\w:.]+$/;
}

#
# Basic Types
#
sub check_bool {
    my $bool = $_[0];

    scalar $bool =~ m!^(|0|1|true|false|yes|no|t|f)$!i
}

sub eval_bool {
    my $bool = $_[0];

    if ( $bool =~ /^(1|true|yes|t)$/i) {
	return 1;
    } elsif ( $bool =~ /^(|0|false|no|n)$/i ) {
	return 0;
    } else {
	croak "invalid boolean value: $bool";
    }
}

sub check_int {
    scalar $_[0] =~ /^[-+]?\s*\d+$/;
}

sub check_string {
    return defined $_[0];
}

sub check_number {
    scalar $_[0] =~ /^[-+]?\s*\d+(\.\d+)?/;
}

sub count2number {
    my ($q, $unit ) = $_[0] =~ /^([.\d]+)\s*(([gG]igas?)?|([mM]egas?)?|([kK]ilos?)?)?/;
    if (! defined $unit) {
	return $q;
    } elsif ( $unit =~ /^m/i) {
	return $q * 1_000_000;
    } elsif ( $unit =~ /^g/i) {
	return $q * 1_000_000_000;
    } elsif ( $unit =~ /^k/i) {
	return $q * 1_000;
    } else {
	return $q; # Unknown units are interpreted as raw number
    }
}

sub number2count {
    my $number = $_[0];

    # Prevent warnings with n/a or other such value
    return $number unless $number =~ /^[\d.]+$/;

    my ( $div, $units );
    if ( $number >= 1_000_000_000 ) {
	$div = 1_000_000_000;
	$units = "G";
    } elsif ($number >= 1_000_000 ) {
	$div = 1_000_000;
	$units = "M";
    } elsif ( $number >= 1_000 ) {
	$div = 1_000;
	$units = "k";
    } else {
	$div = 1;
	$units = "";
    }

    my $q = $number / $div;
    my $int = int $q;
    my $rem = $q - $int;

    $rem ? sprintf( "%.1f$units", $q ) : $int . $units;
}

#
# Time Types
#
sub check_timestamp {
    scalar check_string();
}

sub check_time {
    scalar check_string();
}

sub check_date {
    scalar check_string();
}

sub check_duration {
    scalar $_[0] =~ /^
		      (\d+y(ears?)?     )?\s*   # Years
		      (\d+M(onths?)?    )?\s*   # Months
		      (\d+w(eeks?)?     )?\s*   # Weeks
		      (\d+d(ays?)?      )?\s*	# Days
		      (\d+h(ours?)?     )?\s*	# Hours
		      (\d+m(inu?t?e?s?)?)?\s*	# Minutes
		      (\d+s(seco?n?d?s?))?\s*	# Seconds
		    /x;
}

sub weekly_duration {
    $_[0] =~ /^(\d+)w(?:eeks?)?$/ ? $1 : 0;

}

sub monthly_duration {
    $_[0] =~ /^(\d+)M(?:onths?)?$/ ? $1 : 0;
}

sub yearly_duration {
    $_[0] =~ /^(\d+)y(?:ears?)?$/ ? $1 : 0;
}

sub duration2sec {
    $_[0] =~ /^
	      (?:(\d+)y(?:ears?)?    )?\s*	# Years
	      (?:(\d+)M(?:onths?)?    )?\s*	# Months
	      (?:(\d+)w(?:eeks?)?     )?\s*	# Weeks
	      (?:(\d+)d(?:ays?)?      )?\s*	# Days
	      (?:(\d+)h(?:ours?)?     )?\s*	# Hours
	      (?:(\d+)m(?:inu?t?e?s?)?)?\s*	# Minutes
	      (?:(\d+)s(?:eco?n?d?s?)?)?\s*	# Seconds
	      $/x;
    my ( $years, $months,  $weeks,  $days,   $hours,  $mins, $secs ) =
       ( $1 || 0, $2 || 0, $3 || 0, $4 || 0, $5 || 0, $6 || 0, $7 || 0 );
    my $s = 0;
    $s += $secs;
    $s += $mins * 60;
    $s += $hours * 60 * 60;
    $s += $days * 60 * 60 * 24;
    $s += $weeks * 60 * 60 * 24 * 7;
    $s += $months * 60 * 60 * 24 * 30; # Months and
    $s += $years * 60 * 60 * 24 * 365; # Years are approximation

    $s;
}

sub sec2duration {
    my $sec = $_[0];

    # Prevent warnings with n/a or other such value
    return $sec unless $sec =~ /^[\d.]+$/;

    my ( $div, $units );
    if ( $sec >= 86400 ) {
	$div = 86400;
	$units = "d";
    } elsif ($sec >= 3600 ) {
	$div = 3600;
	$units = "h";
    } elsif ( $sec >= 60 ) {
	$div = 60;
	$units = "m";
    } else {
	$div = 1;
	$units = "s";
    }

    my $q = $sec / $div;
    my $int = int $q;
    my $rem = $q - $int;

    $rem ? sprintf( "%.1f$units", $q ) : $int . $units;
}

#
# Internet Types
#

sub check_ip {
    my @bytes = split /^\.$/, $_[0];

    return 0 if @bytes != 4;

    for my $b ( @bytes ) {
	return 0 if $b < 0 || $b > 255;
    }

    return 1;
}

sub check_port {
    return 0 unless check_number();

    # 2**16 = 65536 : 16 bit port field, cf Stevens, p4
    return 0 if $_[0] < 0 || $_[0] > 65535;
    return 1;
}

sub check_hostname {
    scalar $_[0] =~ /^[-\w]+(\.([-\w]+))*\.?$/;
}

sub check_url {
    scalar check_string();
}

sub check_email {
    scalar check_string();
}

#
# Misc Types
#

sub check_bytes {
    scalar $_[0] =~ /^[.\d]+\s*([mM](egs?)?|[kK]|[gG](igas?)?)?/;
}

sub size2bytes {
    my ($q, $unit ) = $_[0] =~ /^([.\d]+)\s*([mM](egs?)?|[kK]|[gG](igas?)?)?/;
    if (! defined $unit) {
	return $q;
    } elsif ( $unit =~ /^m/i) {
	return $q * 1024 * 1024;
    } elsif ( $unit =~ /^g/i) {
	return $q * 1024 * 1024 * 1024;
    } elsif ( $unit =~ /^k/i) {
	return $q * 1024;
    } else {
	return $q; # Unknown units are interpreted as bytes
    }
}

use constant GIG => 1024 ** 3;
use constant MEG => 1024 ** 2;
use constant K   => 1024;

sub bytes2size {
    my $bytes = $_[0];

    # Prevent warnings with n/a or other such value
    return $bytes unless $bytes =~ /^[\d.]+$/;

    my ( $div, $units );
    if ( $bytes >= GIG ) {
	$div = GIG;
	$units = "G";
    } elsif ($bytes >= MEG ) {
	$div = MEG;
	$units = "M";
    } elsif ( $bytes >= K ) {
	$div = K;
	$units = "k";
    } else {
	$div = 1;
	$units = "";
    }

    my $q = $bytes / $div;
    my $int = int $q;
    my $rem = $q - $int;

    $rem ? sprintf( "%.1f$units", $q ) : $int . $units;
}

sub check_filename {
    scalar check_string();
}

#
# Special Types
#
sub check_type {
    scalar  $_[0] =~ /^(bool|int|number|string		# Basic
		       |timestamp|time|date|duration	# Time
	               |ip|port|hostname|url|email	# Internet
	               |bytes|filename			# Misc
		       |type|field|superservice|chart	# Special
		       )$/x;
}

sub check_field {
    scalar check_xml_name( @_ );
}

sub check_superservice {
    unless (defined $SUPERSERVICE_RE) {
	my $re = join( '|', @Lire::Config::SUPERSERVICES );
	$SUPERSERVICE_RE = qr/^($re)$/;
    }
    scalar $_[0] =~ /$SUPERSERVICE_RE/;
}

sub check_chart {
    scalar $_[0] =~ /^(bars|lines|pie|histogram)$/;
}

sub is_time_type {
    scalar $_[0] =~ /^(timestamp|time|date)$/;
}

sub is_numeric_type {
    scalar is_time_type( @_ ) || scalar is_quantity_type( @_ );
}

sub is_quantity_type {
    scalar $_[0] =~ /^(bytes|int|number|duration)$/;
}

sub format_numeric_type {
    my ($value, $type) = @_;

    $type ||= "number";

    my $fmt_value = $value;
    if ( $type eq 'bytes' ) {
	$fmt_value = bytes2size( $value )
	  if $Lire::Config::LR_SCALE_BYTES;
    } elsif ( $type eq 'duration' ) {
	$fmt_value = sec2duration( $value )
	  if $Lire::Config::LR_SCALE_SEC;
    } elsif ( $Lire::Config::LR_SCALE_NUMBER ) {
	$fmt_value = number2count( $value );
    }

    $fmt_value;
}

# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::DataTypes - check wether value is of declared type

=head1 SYNOPSIS

 use Lire::DataTypes qw( :basic :time :misc format_numeric_type ... );

 $bytes = size2bytes( $min_value );
 $sec = duration2sec( $max_value );
 ...

=head1 DESCRIPTION

Lire::DataTypes offers several routines, like check_url and check_duration, to
decide wether a value is of a Lire type.  Furthermore, routines to process
these types, like duration2sec and bytes2size are offered.  Lire types are
defined in lire-types.mod.

This module is widely used throughout other Lire:: modules.

=head1 VERSION

$Id: DataTypes.pm,v 1.26 2002/07/12 22:51:30 flacoste Exp $

=head1 COPYRIGHT

Copyright (C) 2001 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=cut
