package Common::Util;

use utf8;
use strict;
use Unicode::Collate;

use lib '/app/tools/common/lib';
use Common::RSMath;
use Common::UTF8;

use HTML::Entities;

use Carp;
use Digest::MD5;
use Text::Metaphone;

#use Date::Calc qw(Decode_Date_US Decode_Date_EU Days_in_Month);
use Date::Calc qw(Decode_Date_US Decode_Date_EU Localtime Mktime Days_in_Month Add_Delta_YM Delta_Days);

use Exporter;

use vars qw(@ISA @EXPORT @EXPORT_OK %NORM_SUBSTITUTIONS);

@EXPORT    = qw();
@EXPORT_OK = qw(csvquote trimquotes trimspaces trimleadingzeros commify escape_mysql_regexp escape_mysql_like
  clean clean_name clean_name_catalog moneyize clean_phone norm scrub mphon
  normalize_isrc normalize_upc upc_check_digit normalize_number normalize_date word_containment
  secondsToDateTime dateTimeToSeconds todayPretty decodeDateMysql isValidEmailAddress returnFirstDefined
  dateCompare formatFixedPoint
);
@ISA = 'Exporter';

%NORM_SUBSTITUTIONS = (
    '\bi\b'                 => 'one',            # This is mainly intended to change the roman numeral "I" to "one".
                                                 # But it will also change the very common english word "I" to "one".
                                                 # That will not matter for matching purposes as long as it is done consistently.
    '\bii\b'                => 'two',
    '\biii\b'               => 'three',
    '\biv\b'                => 'four',
    '\bv\b'                 => 'five',
    '\bvi\b'                => 'six',
    '\bvii\b'               => 'seven',
    '\bviii\b'              => 'eight',
    '\bix\b'                => 'nine',
    '\bx\b'                 => 'onezero',
    '\bxi\b'                => 'oneone',
    '\bxii\b'               => 'onetwo',
    '\bxiii\b'              => 'onethree',
    '\bxiv\b'               => 'onefour',
    '\bxv\b'                => 'onefive',
    '\bxvi\b'               => 'onesix',
    '\bxvii\b'              => 'oneseven',
    '\bxviii\b'             => 'oneeight',
    '\bxiv\b'               => 'onenine',
    '\bxx\b'                => 'twozero',
    '\bvol\b'               => 'volume',
    '\bfeat\b'              => 'featuring',
    '\balt\b'               => 'alternate',
    '\bori?g\b'             => 'original',
    '\bw\b'                 => 'with',
    '\bintro\b'             => 'introduction',
    '\bpt\b'                => 'part',
    '\bn\b| & '             => 'and',
    q{'\bbout\b}            => 'about',
    q{'\btil\b}             => 'until',
    q{\bem\b}               => 'them',
    q{'\bround\b}           => 'around',
    '#|\bno\b\.|\bnum\b\.?' => 'number',
    '@'                     => 'at',
    q{in'( |$)}             => 'ing',
    0                       => 'zero',
    1                       => 'one',
    2                       => 'two',
    3                       => 'three',
    4                       => 'four',
    5                       => 'five',
    6                       => 'six',
    7                       => 'seven',
    8                       => 'eight',
    9                       => 'nine',
);

# This hash defines a binary search tree through the alphabet.
#
my %gAlphabetHash = (
    'm' => {
        '-1' => 'f',
        '1'  => 't',
    },
    'f' => {
        '-1' => 'c',
        '1'  => 'j',
    },
    't' => {
        '-1' => 'q',
        '1'  => 'w',
    },
    'c' => {
        '-1' => 'b',    #
        '1'  => 'e',
    },
    'j' => {
        '-1' => 'h',
        '1'  => 'l',
    },
    'q' => {
        '-1' => 'o',
        '1'  => 's',
    },
    'w' => {
        '-1' => 'v',
        '1'  => 'y',
    },
    'b' => {
        '-1' => 'a',    #
    },
    'e' => {
        '-1' => 'd',
    },
    'h' => {
        '-1' => 'g',
        '1'  => 'i',
    },
    'l' => {
        '-1' => 'k',
    },
    'o' => {
        '-1' => 'n',
        '1'  => 'p',
    },
    's' => {
        '-1' => 'r',
    },
    'v' => {
        '-1' => 'u',
    },
    'y' => {
        '-1' => 'x',
        '1'  => 'z',
    },
    'a' => {
        '-1' => '?',
    },
    'z' => {
        '1' => '?',
    }
);

# This does just what you think it does...
#
sub returnFirstDefined {
    foreach my $thing (@_) {
        return $thing if defined $thing;
    }
    return undef;
}

# -----------------------------------
# File stuff
# -----------------------------------

sub md5sum {
    my $file = shift;

    my $fh;
    my $need_close = 0;
    my $digest;

    # accept files or file handles
    # Note: 'Fh' is for CGI 3.x, 'CGI::File::Temp' is for CGI 4.05+
    if ( ref($file) eq 'GLOB' || ref($file) eq 'Fh' || ref($file) eq 'CGI::File::Temp' ) {
        $fh = $file;
    }

    # file has non zero size
    elsif ( -s $file ) {
        open( $fh, $file ) or return undef;
        $need_close = 1;
    } else {

        # not sure what this is
        return undef;
    }

    my $md5 = new Digest::MD5;
    eval { $md5->addfile(*$fh); } or die "md5 error: $@\n";
    $digest = $md5->hexdigest;

    close($fh) if ($need_close);

    return $digest;
}

# -----------------------------------
# String Manipulation
# -----------------------------------
sub escape_mysql_like {
    my @strings = @_;

    foreach (@strings) {
        s/([%_])/\\$1/g;
    }

    return wantarray ? @strings : $strings[0];
}

sub escape_mysql_regexp {
    my @strings = @_;

    foreach (@strings) {
        s/([\W])/_escape_regexp_char($1)/eg;
    }

    return wantarray ? @strings : $strings[0];
}

sub _escape_regexp_char {
    my $char = shift;

    # escape parens specially: [(] or [)]
    #
    if ( $char =~ /[\(\)]/ ) {
        $char =~ s/(.*)/\[$1\]/;
    } else {
        $char = "\\" . $char;
    }

    return $char;
}

# "She's Tha 1!" => "shes_tha_1"
sub OLD_clean_name {
    my @strings = @_;

    foreach (@strings) {

        # lc
        s/([A-Z])/lc($1)/eg;
        s/\s+/_/g;
        s/\W//g;
    }

    return wantarray ? @strings : $strings[0];
}

sub clean_name {
    my ($string) = @_;
    return _clean_string($string);
}

# synonym for clean_name()
sub clean {
    clean_name(@_);
}

sub clean_name_catalog {
    my ($string) = @_;
    return _clean_string( $string, convertNumbers => 1 );
}

# JPK - Trying out an alternate 'clean name' algorithm.
# What I want to do is:
# - strip off leading and trailing spaces.
# - convert high-order characters into some narrow encoding
#   * It would be nice to be able to map these to the 'closest' ascii character, but
#     initially I think I'll just replace those with '?', but it would be better to have
#     a good re-mapping table.
# - remove other symbols.
#   * This might end up a little tricky for UTF8 'symbols'.
# - strip out any extra spaces between words.
# - add in spaces between 'words' where appropriate.
#   * Ex.  'Foo- The Bar'  should encode the same as 'Foo - The Bar' : 'foo_the_bar'
#
sub _clean_string {
    my ( $string, %args ) = @_;

    # convert to lowercase.
    # Note that this DOES appear to work just fine on UTF8 characters.
    #
    # !!! What was the point of this regex?
    #
    $string = lc($string);

    # Unescape HTML entities.
    # So, 'foo&bar' becomes 'foo&bar'.
    #
    HTML::Entities::decode_entities($string);

    # Convert numerals to number words.
    # i.e. '42' becomes 'forty-two'.
    # Do it here before we transform '-' into ' '.
    #
    if ( $args{convertNumbers} ) {
        $string =~ s/(\d+)/&convertIntegerStringToEnglishText($1)/ge;
    }

    # Some special-case handling here, for some edge cases that we've actually seen.
    #
    # These characters should be treated as white space, since they almost always
    # are used to seperate 'words'.
    #
    # !!! Yes, there are utf8 characters embedded in this regex.  The 'use utf8' pragma
    #     at the top of this file makes this work.
    #
    $string =~ s/[…—\-\,\|\&\+]/ /g;

    # convert letters with diacriticals to their 'normal' equivalents.
    #
    $string = strip_diacriticals_lc($string);

    # Remove most other extra characters.
    #
    $string =~ s/[^\w\s\?]//g;

    # compress any extra inner-word spaces to a single underscore
    #
    $string =~ s/\s+/_/g;

    # Strip off leading and trailing underscores.
    #
    $string =~ s/^_+//;
    $string =~ s/_+$//;

    return $string;
}

sub strip_diacriticals_lc {
    my ($string) = @_;
    my $output;
    my @chars = split( //, $string );
    foreach my $c (@chars) {
        $output .= _latinEquiv($c);
    }
    return $output;
}

my $gCollator;

sub _latinEquiv {
    my ($c) = @_;

    # Don't bother with this collation comparison stuff unless this is an extended character.
    # '~' is ascii 126
    #
    return $c unless ( $c gt '~' );

    if ( !$gCollator ) {

        # JPK - Constructing these are expensive.
        # Right now I'm just hanging onto a reference in global scope.
        # It would probably be safer to add this to the RSApp global singleton.
        #
        $gCollator = Unicode::Collate->new();
    }

    my $returnChar;

    my $key     = 'm';
    my $lastKey = $key;
    while ( defined $key ) {
        my $tests = $gAlphabetHash{$key};

        if ( !defined $tests ) {

            # We're at a leaf node on the tree.
            # Return the _last_ key if the value is less than the current key.
            # Otherwise return the current key.
            # The basic idea is that a character with a diacritical will collate between
            # the 'base' letter and the next letter.
            # i.e.  'o' < 'o-with-umlaud' < 'p'
            #
            my $r = $gCollator->cmp( $c, $key );
            if ( -1 == $r ) {
                $returnChar = $lastKey;
                last;
            } else {
                $returnChar = $key;
                last;
            }
        }
        $lastKey = $key;

        my $r = $gCollator->cmp( $c, $key );
        my $nextKey = $tests->{$r};
        if ( !defined $nextKey ) {
            $returnChar = $key;
            last;
        }
        if ( '?' eq $nextKey ) {

            #            $returnChar = $c;
            #            $returnChar = '?';
            if ( $c =~ /\w/ ) {
                $returnChar = 'x';
            } else {
                $returnChar = '';
            }
            last;
        }
        $key = $nextKey;
    }

    return $returnChar;
}

# Going to create a slightly different version of 'clean' for book titles.
# I want to strip out:
# - Stuff in parenthesis.
# - 'The '
# But I don't want to break the regular 'clean' method, which is used all over the place.
#
sub clean_book_title {
    my @strings = @_;

    foreach (@strings) {
        s/^the //i;
        s/^a //i;
        s/^an //i;
        s/^\s+//;
        s/\s+$//;

        # Replace all remaining stretches of whitespace or nonword characters with a single '_'
        # So, the string 'foo : a bar' and 'foo, a bar' and 'foo,a bar' would all clean down to
        # 'foo_a_bar'
        #
        #        s/\(.*\)//g;
        s/\s/_/g;
        s/\W/_/g;
        s/_+/_/g;

        s/([A-Z])/lc($1)/eg;
    }

    return wantarray ? @strings : $strings[0];
}

sub moneyize {
    my $string = shift;

    return commify( sprintf( "%01.2f", $string ) );
}

sub pretty_phone {
    my $string = shift;

    # We will make the assumption that if the phone number
    # is entered with a leading +, they wrote it correctly.
    if ( $string !~ /^[+]/ ) {
        $string =~ s/^(\d{3})(\d{4})$/$1-$2/g;
        $string =~ s/^(\d{3})(\d{3})(\d{4})$/\($1\) $2-$3/g;
        $string =~ s/x(\d+)/ x$1/i;
        $string =~ s/^(\d{3})(\d{3})(\d{4}) /\($1\) $2-$3 /g;
    }

    return $string;
}

sub clean_phone {
    my $string = shift;

    # We will make the assumption that if the phone number
    # is entered with a leading +, they wrote it correctly.
    if ( $string !~ /^[+]/ ) {
        $string =~ s/[^xX0-9]//g;
        $string =~ s/^1(\d{10})(x\d+)?$/$1$2/i;
    }

    return $string;
}

sub norm {
    my @string = @_;

    foreach my $str (@string) {
        $str = lc $str;
        while ( my ( $search, $replace ) = each %NORM_SUBSTITUTIONS ) {

            # add a space around replace string
            # (some matches depend on whitespace and we don't want one search to affect another)
            $str =~ s/$search/ $replace /g;
        }
        $str =~ s/[^a-z0-9]+//g;
    }

    return wantarray ? @string : $string[0];
}

# same as norm but keep the spaces
sub norm_space {
    my @string = @_;

    foreach my $str (@string) {
        $str = lc $str;
        while ( my ( $search, $replace ) = each %NORM_SUBSTITUTIONS ) {
            $str =~ s/$search/$replace/g;
        }
        $str =~ s/[,:;\-\(\)\[\]\{\}\+=]/ /g;
        $str =~ s/[^a-z0-9\s]+//g;
        $str =~ s/^\s+//;
        $str =~ s/\s+$//;
        $str =~ s/\s{2,}/ /g;
    }

    return wantarray ? @string : $string[0];
}

sub scrub {
    my @string = @_;

    foreach my $str (@string) {

        $str = lc $str;

        # remove comments in parens or brackets at end of string
        $str =~ s{
	            \s*         # any whitespace
             	[\(\[]      # opening paren or bracket
	            [^\)\]]*    # zero or more chars that isn't a closing paren or bracket
               [\)\]]      # closing paren or bracket
               \s*         # any whitespace
            	$           # end of string
	          }
		       {}x;    # replace with nothing

        # strip either (but not both):
        # (1) "a " or "the " from beginning
        # (2) ", a" or ", the" from the end
        $str =~ s/^\s*(a|the)\s+// || $str =~ s/,\s+(a|the)\s*$//;
    }

    return norm(@string);
}

# keep trimming pairs of start/end quotes until they're all gone
# NOTE: don't blindly remove ALL quotes from start and end in one shot
# input:  "Simon Says "STOP!""
# output: Simon Says STOP! # Wrong!
# output: Simon Says "STOP!" # Right!
sub trimquotes {
    my @string = trimspaces(@_);

    for (@string) {
        while (s/^\"(.*)\"$/$1/) { }
    }
    return wantarray ? @string : $string[0];
}

sub trimspaces {
    my @string = @_;

    for (@string) {
        next unless ( defined($_) );
        s/^\s+//;
        s/\s+$//;
    }
    return wantarray ? @string : $string[0];
}

sub trimleadingzeros {
    my @string = @_;

    for (@string) {
        s/^0+//;
    }
    return wantarray ? @string : $string[0];
}

# returns a text representation of what a string "sounds like"
# (It's a bit like Soundex, except that it is more advanced)
sub mphon {
    my @string = @_;

    foreach my $str (@string) {
        if ( $str =~ m/^\wx+\wx+\wx+\wx+/i ) {
            print STDERR "'$str' will cause mphon error\n";
            next;
        }
        $str = Metaphone($str);
    }
    return wantarray ? @string : $string[0];
}

# taken from "perldoc -q comma"
# "1499999.99" => "1,499,999.99"
sub commify {
    local $_ = shift;
    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
    return $_;
}

# -----------------------------------
# Dates
# -----------------------------------

# mysql date format
sub today {
    my ( undef, undef, undef, $mday, $mon, $year, undef, undef, $isdst ) = localtime(time);
    return sprintf( "%4d-%02d-%02d", $year + 1900, $mon + 1, $mday );
}

sub todayPretty {
    my ( undef, undef, undef, $mday, $mon, $year, undef, undef, $isdst ) = localtime(time);

    my $dateTimeFormat = Common::Client::Current()->Locale()->dateTimeFormat()->dateFormat();

    if ( $dateTimeFormat =~ /D\/M\/Y/i ) {
        return sprintf( "%02d/%02d/%4d", $mday, $mon + 1, $year + 1900 );
    }

    return sprintf( "%02d/%02d/%4d", $mon + 1, $mday, $year + 1900 );
}

# mysql datetime format
sub today_and_now {
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    return sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
}

# transform dates to our standard format - yyyy-mm-dd
# accepts a date string and a flag indicating european input format
sub normalize_date {
    my $date = shift;
    my $euro = shift;

    my $normalized;
    my $year;
    my $month;
    my $day;

    # 8 digit dates are year first and then euro or not
    if ( $date =~ /^\d{8}$/ ) {
        $year = substr( $date, 0, 4 );
        if ($euro) {
            $month = substr( $date, 6, 2 );
            $day   = substr( $date, 4, 2 );
        } else {
            $month = substr( $date, 4, 2 );
            $day   = substr( $date, 6, 2 );
        }
    } else {

        # Decode_Date_xx routines expect year last, so put it there if we can tell
        my $sep;
        ( $year, $sep ) = $date =~ /^(\d\d\d\d)([\.\-\/])/;
        if ( $year && $sep ) {
            $date = substr( $date, 5 ) . $sep . $year;
        }

        if ($euro) {
            ( $year, $month, $day ) = Decode_Date_EU($date);
        } else {
            ( $year, $month, $day ) = Decode_Date_US($date);
        }
    }

    if ( $year && $month && $day ) {
        $normalized = sprintf( "%04d-%02d-%02d", $year, $month, $day );
    }

    return $normalized;
}

# pass normalized (mysql'ized) dates (yyyy-mm-dd)
# assumptions:
# if starting day is <= 7 days from the end of the month, then month is incremented (if month != ending month)
# if ending day is <= 7, then month is decremented (if month != starting month)
sub normalize_sales_month_dates {
    my ( $dBeg, $dEnd ) = @_;
    return undef unless ( $dBeg and $dEnd );

    my @dateParts = qw(y m d);
    my ( %dBeg, %dEnd );
    @dBeg{@dateParts} = split /-/, $dBeg;
    @dEnd{@dateParts} = split /-/, $dEnd;

    my $days_mBeg;
    my $days_mEnd;

    eval {
        $days_mBeg = Days_in_Month( $dBeg{y}, $dBeg{m} );
        $days_mEnd = Days_in_Month( $dEnd{y}, $dEnd{m} );
    };

    if ($@) {
        confess($@);
    }

    # normalize dates that are not at the 1st or last of the month
    if ( $days_mBeg - $dBeg{d} <= 7 && $dBeg{m} != $dEnd{m} ) {
        ( $dBeg{y}, $dBeg{m} ) = Add_Delta_YM( $dBeg{y}, $dBeg{m}, $dBeg{d}, 0, 1 );
        $dBeg{d} = 1;
        $days_mBeg = Days_in_Month( $dBeg{y}, $dBeg{m} );
    }

    if ( $dEnd{d} <= 7 && $dBeg{m} != $dEnd{m} ) {
        ( $dEnd{y}, $dEnd{m} ) = Add_Delta_YM( $dEnd{y}, $dEnd{m}, $dEnd{d}, 0, -1 );
        $days_mEnd = Days_in_Month( $dEnd{y}, $dEnd{m} );
        $dEnd{d} = $days_mEnd;
    }

    # same month/year
    if ( $dBeg{m} == $dEnd{m} and $dBeg{y} == $dEnd{y} ) {
        return ( sprintf( "%d-%02d-01", $dBeg{y}, $dBeg{m} ), sprintf( "%d-%02d-%02d", $dBeg{y}, $dBeg{m}, $days_mBeg ), );
    }

    # more days in the beginning month
    elsif ( $days_mBeg - $dBeg{d} + 1 > $dEnd{d} ) {
        unless ( $dEnd{d} >= $days_mEnd - 7 )    # for short months (like feb) don't change end month
        {
            ( $dEnd{y}, $dEnd{m} ) = Add_Delta_YM( $dEnd{y}, $dEnd{m}, $dEnd{d}, 0, -1 );
            $days_mEnd = Days_in_Month( $dEnd{y}, $dEnd{m} );
        }

        return ( sprintf( "%d-%02d-01", $dBeg{y}, $dBeg{m} ), sprintf( "%d-%02d-%02d", $dEnd{y}, $dEnd{m}, $days_mEnd ), );
    }

    # more days in the ending month
    elsif ( $dEnd{d} > $days_mBeg - $dBeg{d} + 1 ) {
        unless ( $dBeg{d} <= 7 )                 # for short months (like feb) don't change start month
        {
            ( $dBeg{y}, $dBeg{m} ) = Add_Delta_YM( $dBeg{y}, $dBeg{m}, $dBeg{d}, 0, 1 );
        }

        return ( sprintf( "%d-%02d-01", $dBeg{y}, $dBeg{m} ), sprintf( "%d-%02d-%02d", $dEnd{y}, $dEnd{m}, $days_mEnd ), );
    }

    # same number of days, (jul 1 - aug 31)
    elsif ( $days_mBeg == $days_mEnd && $dBeg{d} <= 7 && $dEnd{d} >= $days_mEnd - 7 ) {
        return ( sprintf( "%d-%02d-01", $dBeg{y}, $dBeg{m} ), sprintf( "%d-%02d-%02d", $dEnd{y}, $dEnd{m}, $days_mEnd ), );
    }

    # else they must be equal so we really don't know which month to choose
    print STDERR "equal days in months: $dBeg $dEnd\n";
    return ( undef, undef );
}

# make sure data passed is in a signed decimal number (and then return it)
#
# don't strip anything to make it so (or we might make numbers out of non-numeric data)
#
# in the future, we may consider handling thousands separators and/or
# dealing with international equivalents for same (including decimal separator)
# (those could be stripped/handled)
sub normalize_number {
    my $num = shift;

    my $normalized;

    ($normalized) = $num =~ /^(-?\d*(\.\d*)?)$/;

    return $normalized;
}

# -----------------------------------
# field specific
# -----------------------------------

sub normalize_upc {
    my $upc = shift;

    # remove dashes and spaces
    $upc =~ s/\W+//g;

    # strip leading zeros if it's too long
    if ( length($upc) > 12 ) {
        my $offset = length($upc) - 12;
        if ( substr( $upc, 0, $offset ) == 0 ) {
            $upc = substr( $upc, $offset );
        }
    } else {

        # try some things to fix short upcs. since short ones can't be
        # correct, not likely that we'll make things worse.
        if ( length($upc) == 11 ) {

            # the most common first digit of a valid upc is zero,
            # so if tacking on a leading zero produces a valid upc
            # then that's what we'll do to fix it up.
            # otherwise, we'll assume the problem is that it's missing
            # the check digit (and tack one on).
            if ( upc_check_digit( "0" . $upc ) == substr( $upc, 10, 1 ) ) {
                $upc = "0" . $upc;
            } else {
                $upc = $upc . upc_check_digit($upc);
            }
        } elsif ( length($upc) == 10 ) {

            # assume it's missing the zero number system character (most common)
            # and needs a check digit too.
            $upc = "0" . $upc;
            $upc = $upc . upc_check_digit($upc);
        }
    }

    return $upc;
}

sub upc_check_digit {
    my $upc = shift;

    my $check = 0;

    for ( my $i = 0 ; $i < 11 ; $i++ ) {
        my $digit = substr( $upc, $i, 1 );
        $check += ( $i % 2 ? $digit : $digit * 3 );
    }

    return ( 1000 - $check ) % 10;
}

sub normalize_isrc {
    my $isrc = shift;

    # strip spaces, dashes and convert to upper, that's about it for now
    $isrc =~ s/\W+//g;

    return uc($isrc);
}

#
# deduce field delimiter by looking at frequency within
# first 1000 characters of file if a file handle is passed or
# in the text passed in by a string
#
sub GetDelimiter {
    my $arg = shift;
    my $delimiter;
    my $slurp;

    if ( $arg =~ /^\*/ ) {
        my $savePos = tell($arg);
        seek( $arg, 0, 0 );

        my $s;
        {
            local $/ = undef;
            read( $arg, $s, 1000 );
        }
        seek( $arg, $savePos, 0 );

        $slurp = $s;
    } else {
        $slurp = $arg;
    }

    my $cntComma = () = $slurp =~ /\,/g;
    my $cntTab   = () = $slurp =~ /\t/g;
    my $cntPipe  = () = $slurp =~ /\|/g;
    my $cntSemi  = () = $slurp =~ /\;/g;

    if ( $cntPipe > $cntTab && $cntPipe > $cntComma && $cntPipe > $cntSemi) {
        $delimiter = '\|';
    } elsif ( $cntTab > $cntComma && $cntTab > $cntPipe && $cntTab > $cntSemi ) {
        $delimiter = "\t";
    } elsif ( $cntSemi > $cntComma && $cntSemi > $cntPipe && $cntSemi > $cntTab ) {
        $delimiter = ";";
    }

    if ( !$delimiter && $cntComma ) {
        $delimiter = ",";
    }

    return $delimiter;
}

#
# We use this instead of a standard read loop in order to deal with
# files where it doesn't seem like folks give a crud what they terminate
# a line with (even within a single file!)
#
# Specifically, it deals with files with more than one line termination
# character.
#
# Handles unix (^J), windows (^M^J), and mac (^M)
#
sub ReadMostTextFiles {
    my $fh = shift;

    my @lines;

    {
        #
        # pretty simple, just set slurp mode which reads the file as
        # one giant line and then use a regular expression split to
        # break it into lines
        #
        local $/ = undef;
        @lines = split( /(?:\cM\cJ|\cM|\cJ)/m, <$fh> );
    }

    return \@lines;
}

#
# This method is based on ReadMostTextFiles, with one addition.  B&N
# We're including ^M character withing quoted data and terminating lines
# with linefeeds.  The ^M was causing the line to split prematurly.
# So this method tries to sanitize CR LFs.
#
sub ReadBookPubTextFiles {
    my $fh = shift;

    my @lines;
    my $currentLine = '';
    my $oddQuotes = 0;

    while (my $line = <$fh>) {
        $line =~ s/\R//g;  # Remove any line ending characters (\n or \r)

        # Determine the quote character (initially for RSD-10243 then extended for RSD-10300)
        if ( $line =~ /(?<!\\)(["])(?:[^\\]*?(?:\\.[^\\]*?)*?)\1[,;]|[,;](?<!\\)(["])(?:[^\\]*?(?:\\.[^\\]*?)*?)\2/ ) {
            if ( my $quote = $1 || $2 ) {
                my $quoteCount = () = $line =~ /(?<!\\)$quote/g;
                $oddQuotes = !$oddQuotes if $quoteCount % 2 == 1;

                $currentLine .= $line;

                if (!$oddQuotes) {
                    push @lines, $currentLine;
                    $currentLine = '';
                }
                next;
            }
        }

        $currentLine .= $line;
        push @lines, $currentLine;
        $currentLine = '';
    }

    push @lines, $currentLine if $currentLine;

    return \@lines;
}

# prepare a value to be included in a csv file
#
# Example:
# input: Simon Says, "STOP!"
# output: "Simon Says, ""STOP!"""
sub csvquote {
    my @string = @_;

    foreach (@string) {
        s/\"/\"\"/g;    # turn each " into ""
        s/^(.+)$/\"$1\"/;
    }
    return wantarray ? @string : $string[0];
}

sub is_interactive {
    return -t STDIN && -t STDOUT;
}

# !!! This was returning true even if one of the strings was blank...
sub word_containment {

    # JPK - These calls to norm_space may not be necessary.
    # They probably are NOT necessary if we're looking at strings that have already been
    # cleaned.
    # I don't know if there are other places where we rely on this behavior, so tread carefully.
    #
    #    my $w1 = norm_space(shift);
    #    my $w2 = norm_space(shift);
    my ( $w1, $w2, $skipNormFlag ) = @_;
    if ( !$skipNormFlag ) {
        $w1 = norm_space($w1);
        $w2 = norm_space($w2);
    }

    return 0 if ( $w1 eq '' || $w2 eq '' );

    my $match = 1;
    foreach my $word ( split /\s/, $w1 ) {

        # !!! This breaks if $word contains regex quantifiers, like '?'.
        # !!! Surely there is a way to avoid that?
        unless ( $w2 =~ /\b\Q$word\E\b/ ) {
            $match = 0;
            last;
        }
    }

    return 1 if $match;

    $match = 1;
    foreach my $word ( split /\s/, $w2 ) {
        unless ( $w1 =~ /\b\Q$word\E\b/ ) {
            $match = 0;
            last;
        }
    }

    return $match;
}

sub secondsToDateTime {
    my ($time) = @_;
    my ( $year, $month, $day, $hour, $min, $sec, $doy, $dow, $dst );

    eval { ( $year, $month, $day, $hour, $min, $sec, $doy, $dow, $dst ) = Date::Calc::Localtime($time); };

    if ($@) {
        confess($@);
    }

    return "$year-$month-$day $hour:$min:$sec";
}

sub dateTimeToSeconds {
    my ($dateTime) = @_;
    my ( $date, $time ) = split( / /, $dateTime );
    my ( $year, $month, $day ) = split( '-', $date );
    my ( $hour, $min,   $sec ) = split( ':', $time );

    my $seconds;

    eval { $seconds = Date::Calc::Mktime( $year, $month, $day, $hour, $min, $sec ); };

    if ($@) {
        confess($@);
    }

    return $seconds;
}

sub decodeDateMysql {
    my ($dateString) = @_;

    my ( $year, $month, $day ) = split( '-', $dateString );
    if ( $year && $month && $day ) {
        return ( $year, $month, $day );
    }
    return 0;
}

# Snagged this off the web: http://www.unix.org.ua/orelly/linux/cgi/ch09_02.htm
#
sub isValidEmailAddress {
    my ($addr_to_check) = @_;

    $addr_to_check =~ s/("(?:[^"\\]|\\.)*"|[^\t "]*)[ \t]*/$1/g;

    my $esc      = '\\\\';
    my $space    = '\040';
    my $ctrl     = '\000-\037';
    my $dot      = '\.';
    my $nonASCII = '\x80-\xff';
    my $CRlist   = '\012\015';
    my $letter   = 'a-zA-Z';
    my $digit    = '\d';

    my $atom_char = qq{ [^$space<>\@,;:".\\[\\]$esc$ctrl$nonASCII] };
    my $atom      = qq{ $atom_char+ };
    my $byte      = qq{ (?: 1?$digit?$digit |
                              2[0-4]$digit    |
                              25[0-5]         ) };

    my $qtext       = qq{ [^$esc$nonASCII$CRlist"] };
    my $quoted_pair = qq{ $esc [^$nonASCII] };
    my $quoted_str  = qq{ " (?: $qtext | $quoted_pair )* " };

    my $word       = qq{ (?: $atom | $quoted_str ) };
    my $ip_address = qq{ \\[ $byte (?: $dot $byte ){3} \\] };

    # Subdomain can be a string of letter/digits (min 1 character), or can have a hyphen if
    # surrounded by letter/digits (min 3 characters).
    my $sub_domain = qq{ ( [$letter$digit]+ [$letter$digit-]* [$letter$digit]+ | [$letter$digit] ){1,61} };

    # TLD can be up to 63 chars; accept anything from 2 to 63
    my $top_level   = qq{ (?: $atom_char ){2,63} };
    my $domain_name = qq{ (?: $sub_domain $dot )+ $top_level };
    my $domain      = qq{ (?: $domain_name | $ip_address ) };
    my $local_part  = qq{ $word (?: $dot $word )* };
    my $address     = qq{ $local_part \@ $domain };

    return $addr_to_check =~ /^$address$/ox ? $addr_to_check : "";
}

# Standard 'compare' interface:
# -- return -1 if $dateA < $dateB
# -- return 0 if $dateA == $dateB
# -- return 1 if $dateA > $dateB
#
sub dateStringCompare {
    my ( $dateA, $dateB ) = @_;

    my ( $yearA, $monthA, $dayA ) = decodeDateMysql($dateA);
    my ( $yearB, $monthB, $dayB ) = decodeDateMysql($dateB);
    my $delta = Delta_Days( $yearA, $monthA, $dayA, $yearB, $monthB, $dayB );

    return 1  if $delta < 0;
    return -1 if $delta > 0;
    return 0;
}

# Format fixed point numbers for output suitable mostly to other systems
# (as in, not people, who might like things localized).
#
# Output is rounded using RSMath::round, which implements the rounding that
# most lay people (and accountants and Excel and school children) are familiar
# with. This is formally referred to as Half Up rounding and contrasts with
# the more scientific (and symmetric) rounding that Perl uses on _some_
# platforms (including ours).
#
# formatFixed() takes a number and a precision that, besides specifying where
# to round, also specifies how many places follow the decimal point, which
# will be padded with zeros if necessary. A leading zero is always displayed
# before the decimal place. A precision of zero rounds to an integer and
# omits the decimal point
#
# Examples:
#   formatFixedPoint(0.1, 2) returns 0.10
#   formatFixedPoint(3.14159, 3) returns 3.142
#
sub formatFixedPoint {
    my ( $number, $precision ) = @_;

    return ( sprintf( "%0." . $precision . "f", Common::RSMath::round( $number, $precision ) ) );
}

# print a hex representation of a string
sub hexdump {
    my $offset = 0;
    my ( @array, $format );
    foreach my $data ( unpack( "a16" x ( length( $_[0] ) / 16 ) . "a*", $_[0] ) ) {
        my ($len) = length($data);
        if ( $len == 16 ) {
            @array = unpack( 'N4', $data );
            $format = "0x%08x (%05d)   %08x %08x %08x %08x   %s\n";
        } else {
            @array = unpack( 'C*', $data );
            $_ = sprintf "%2.2x", $_ for @array;
            push( @array, '  ' ) while $len++ < 16;
            $format = "0x%08x (%05d)" . "   %s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s   %s\n";
        }
        $data =~ tr/\0-\37\177-\377/./;
        printf $format, $offset, $offset, @array, $data;
        $offset += 16;
    }
}

# These tables are for the numberToText algorithm.

my %gMultiplierText = (
    1  => ' thousand ',
    2  => ' million ',
    3  => ' billion ',
    4  => ' trillion ',
    5  => ' quadrillion ',
    6  => ' quintillion ',
    7  => ' sextillion ',
    8  => ' septillion ',
    9  => ' octillion ',
    10 => ' nonillion ',
    11 => ' decillion ',
);

my %gTeensText = (
    0 => 'ten ',
    1 => 'eleven ',
    2 => 'twelve ',
    3 => 'thirteen ',
    4 => 'fourteen ',
    5 => 'fifteen ',
    6 => 'sixteen ',
    7 => 'seventeen ',
    8 => 'eighteen ',
    9 => 'nineteen ',
);

my %gTensText = (
    2 => 'twenty',
    3 => 'thirty',
    4 => 'forty',
    5 => 'fifty',
    6 => 'sixty',
    7 => 'seventy',
    8 => 'eighty',
    9 => 'ninety',
);

my %gOnesText = (
    1 => 'one',
    2 => 'two',
    3 => 'three',
    4 => 'four',
    5 => 'five',
    6 => 'six',
    7 => 'seven',
    8 => 'eight',
    9 => 'nine',
);

sub convertIntegerStringToEnglishText {
    my ($string) = @_;

    my $chunks = _chunk($string);

    my $outString;
    my $multiplier = 0;
    foreach my $chunk (@$chunks) {
        my $chunkString;

        # The 'teens' are a wacky special case in english...
        #
        if ( $chunk->[1] && '1' eq $chunk->[1] ) {
            $chunkString = $gTeensText{ $chunk->[0] };
        } else {
            $chunkString = $gTensText{ $chunk->[1] };
            $chunkString .= '-' if ( $chunk->[0] && $chunk->[1] );
            $chunkString .= $gOnesText{ $chunk->[0] };
        }

        if ( $chunk->[2] ) {
            $chunkString = $gOnesText{ $chunk->[2] } . ' hundred ' . $chunkString;
        }
        if ($multiplier) {
            $chunkString .= $gMultiplierText{$multiplier};
        }

        $outString = $chunkString . $outString;

        $multiplier++;
    }

    return $outString;
}

sub _chunk {
    my ($string) = @_;

    my @chars = reverse( split( //, $string ) );

    my @chunks;
    while ( my $len = scalar @chars ) {
        $len = 3 if $len > 3;

        my @chunk;
        for ( my $i = 0 ; $i < $len ; $i++ ) {
            push @chunk, shift(@chars);
        }
        push @chunks, \@chunk;
    }

    return \@chunks;
}

###
1;    # Play nicely.
###