view release on metacpan or  search on metacpan

lib/App/Widget/ValidatedTextField.pm  view on Meta::CPAN

        $monthtext = $1;
        $day = $2;
        $year = $3;
    }
    elsif ($datetext =~ /\b([0-9]{1,2})[- ]+([a-zA-Z]+)[- ]+([0-9]{2,4})\b/) {  # i.e. 31-Dec-1999, 9 march 01
        $day = $1;
        $monthtext = $2;
        $year = $3;
    }
    elsif ($datetext =~ /\b([0-9]{4})([0-9]{2})([0-9]{2})\b/) {     # i.e. 19991231, 20010309
        $year = $1;
        $mon = $2;
        $day = $3;
    }
    elsif ($datetext =~ m!\b([0-9]{4})[- /]+([0-9]{1,2})[- /]+([0-9]{1,2})\b!) { # i.e. 1999-12-31, 2001/3/09
        $year = $1;
        $mon = $2;
        $day = $3;
    }
    elsif ($datetext =~ m!\b([0-9]{1,2})[- /]+([0-9]{1,2})[- /]+([0-9]{2,4})\b!) {  # i.e. 12/31/1999, 3-9-01
        $mon = $1;
        $day = $2;
        $year = $3;
    }
    else {
        return("");
    }
    if ($monthtext) {
        if    ($monthtext =~ /^jan/i) { $mon =  1; }
        elsif ($monthtext =~ /^feb/i) { $mon =  2; }
        elsif ($monthtext =~ /^mar/i) { $mon =  3; }
        elsif ($monthtext =~ /^apr/i) { $mon =  4; }
        elsif ($monthtext =~ /^may/i) { $mon =  5; }
        elsif ($monthtext =~ /^jun/i) { $mon =  6; }
        elsif ($monthtext =~ /^jul/i) { $mon =  7; }
        elsif ($monthtext =~ /^aug/i) { $mon =  8; }
        elsif ($monthtext =~ /^sep/i) { $mon =  9; }
        elsif ($monthtext =~ /^oct/i) { $mon = 10; }
        elsif ($monthtext =~ /^nov/i) { $mon = 11; }
        elsif ($monthtext =~ /^dec/i) { $mon = 12; }
        else                          { return("");  }
    }
    if ($year < 0) { return(""); }
    elsif ($year < 50) { $year += 2000; }
    elsif ($year < 100) { $year += 1900; }
    elsif ($year < 1000) { return(""); }
    return("") if ($mon > 12);
    return("") if ($day > 31);
    sprintf("%04d-%02d-%02d",$year,$mon,$day);
}

sub format_phone {
    my ($self, $phonetext) = @_;
    return "" if (!$phonetext);
    return $phonetext if ($phonetext =~ /^[0-9]{3}-[0-9]{3}-[0-9]{4}$/);  # correct format: 213-394-8654
    my ($phone, $ext);
    $phone = $phonetext;
    $phone =~ s/^ +//;         # delete leading spaces
    $phone =~ s/ +$//;         # delete trailing spaces
    $phone =~ s![- \(\)/]!!g;  # delete common telephone number delimiters
    if ($phone =~ /^1?([0-9]{3})([0-9]{3})([0-9]{4})$/) {   # i.e. 1-800-732-4556, 770/933-0551, 404 4322664
        $phone = "$1-$2-$3";
    }
    elsif ($phone =~ /^1?([0-9]{3})([0-9]{3})([0-9]{4})([^0-9].*)/) {   # i.e. 404-432-2664 x352
        $phone = "$1-$2-$3";
        $ext = $4;
        $ext =~ s/^ +//;         # delete leading spaces
        $ext =~ s/ +$//;         # delete trailing spaces
        $phone .= " $ext";  # put the extension back on with a space
    }
    elsif ($phone =~ /^([0-9]{3})([0-9]{4})$/) {   # i.e. 933-0551, 4322664
        $phone = "$1-$2";
    }
    elsif ($phone =~ /^([0-9]{3})([0-9]{4})([^0-9].*)/) {   # i.e. 432-2664 x352
        $phone = "$1-$2";
        $ext = $3;
        $ext =~ s/^ +//;         # delete leading spaces
        $ext =~ s/ +$//;         # delete trailing spaces
        $phone .= " $ext";  # put the extension back on with a space
    }
    else {
        $phone = $phonetext;   # I can't reformat it. I'll return it as it came to me.
    }
    $phone;
}

sub format_zip {
    my ($self, $ziptext) = @_;
    return "" if (!$ziptext);
    return $ziptext if ($ziptext =~ /^[0-9]{5}$/);  # correct format: 213-394-8654
    my $zip = $ziptext;
    $zip =~ s/[- ]//g;      # delete spaces and dashes
    if ($zip =~ /^([0-9]{5})([0-9]{4})?$/) {
        $zip = $1;
        $zip .= "-$2" if ($2 ne "");
    }
    else {
        $zip = $ziptext;   # I can't reformat it. I'll return it as it came to me.
    }
    $zip;
}

sub format_mixedcase {
    my ($self, $text) = @_;
    return "" if (!defined $text);
    my $ftext = $text;
    if ($ftext =~ /[a-z]/ && $ftext !~ /[A-Z]/) {      # all lower-case
        $ftext =~ s/([a-zA-Z])([a-zA-Z]*)/uc($1).lc($2)/ge;
    }
    elsif ($ftext !~ /[a-z]/ && $ftext =~ /[A-Z]/ && length($ftext) > 2) {   # ALL UPPER-CASE
        $ftext =~ s/([a-zA-Z])([a-zA-Z]*)/uc($1).lc($2)/ge;
    }
    else {
        $ftext = $text;   # I can't reformat it. I'll return it as it came to me.
    }
    $ftext;
}

sub format_ssn {
    my ($self, $ssntext) = @_;
    my $ssn = $ssntext;
    $ssn =~ s/[- ]//g;      # delete spaces and dashes
    if ($ssn =~ /^([0-9][0-9][0-9])([0-9][0-9])([0-9][0-9][0-9][0-9])$/) {
        $ssn = "$1-$2-$3";