Data::Describe - Perl extension for scanning/describing a text file

  use Data::Describe;

  $dsp = Data::Describe->new;       # create an empty object
  my %arg = ( input_file_name => 'input.txt', # the same as 'ifn' 
              skip_first_row  => 'Y',         # the same as 'sfr'
              input_field_sep => ',',         # the same as 'ifs'
              ofs=>'|',             # the same as 'output_field_sep'
              ofn=>'out.dat',       # the same as 'output_file_name'
              odf=>'out.def',       # the same as 'output_def_file'
            );
  $dsp = Data::Describe->new(%arg); # with arguments

  $dsp->skip_first_row;             # i,e. 1st row contains col names
  $dsp->set_sfr(1);                 # is the same as the above       

  $dsp->set_ifs('\t');              # set input field separator to tab
  $dsp->input_field_separator('|'); # set input field separator to '|'
  $dsp->set_ofs('|');               # set output field separator to |
  $dsp->output_field_separator('|');# set output field separator to | 

  $dsp->set_ifn('input.txt');       # set input file name
  $dsp->input_file_name('input.txt'); # set input file name
  $dsp->input_file_name($arf);      # it can be array ref

  $dsp->set_ofn('out.dat');         # set output file name
  $dsp->output_file_name('out.dat');# set output file name
  $dsp->output_file_name('Y');      # it can be array ref

  $dsp->set_odf('out.def');         # set output def file name
  $dsp->output_def_file('output.def');# set output definition file name
  $dsp->output_def_file('Y');       # default to '${in}.def" 

  # all the set method has its corresponding get method
  $rc      = $dsp->get_sfr;
  $rc      = $dsp->get_ifs; 
  $rc      = $dsp->input_field_separator; # the same as get_ifs

  $dsp->debug(5);                   # set debug level to 5
  $dsp->echoMSG('This message', 1); # tag the message as level 1
  my $crf = $dsp->get_def_arrayref;
  my $drf = $dsp->get_dat_arrayref;
  $dsp->output($crf, "", 'def');    # output def file to STDOUT
  $dsp->outptu($drf, 'out.dat', 'dat'); 

  col - column name
  typ - column type, 'N' for numeric, 'C' for characters, 
        and 'D' for date
  max - maximum length of the records in the column
        (could use 'wid' to record the max length of the 
         records.)
  min - minimum length of the record in the column
        (When 'wid' is used, no 'min' is needed.)
  dft - date format such as YYYY/MM/DD, MON/DD/YYYY, etc.
  dec - maximun decimal length of the record in the column
  req - whether there is null or zero length records in the 
        column only 'NOT NULL is shown
  dsp - description of the columns

  $dsc = Data::Describe->new;   # an empty object

  %attr = ( 
     input_field_sep => ':',    # output field separator
     skip_first_row' => 1,      # 1st row has col names
    );
  $dsp = Data::Describe->new(%attr);

  $dsp->skip_first_row('Y');      # first row contains column names
  $dsp->set_sfr('Y');             # the same as the above
  $dsp->set_sfr(1);               # the same as the above

  $dsp->set_sfr('N');             # no column in the first row
  $dsp->skip_first_row(0);        # the same as the above

package Data::Describe;

use strict;
use vars qw($AUTOLOAD);
use Carp;
use warnings;

# require Exporter;

use IO::File;
use File::Basename;
# use Fax::DataFax::DateTime qw(get_date_format);

# This allows declaration       use DataFax ':all';
# If you do not need this, moving things directly into @EXPORT or
# @EXPORT_OK will save memory.
our @ISA;
our %EXPORT_TAGS = ( 'all' => [ qw(describe) ] );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT      = qw( );
our $VERSION     = '1.03';

# bootstrap Data::Describe $VERSION;

{  # Encapsulated class data
    my %_attr_data =                        # default accessibility
    ( # method          => ['type', 'access', 'default value']
      # method type:    $ - scalar method
      #                 % - array ref method
      # method access:  R - read access
      #                 W - write access
      # method default: undef - undefined initially, but r
      #                         equired at runtime
      _ifn              => ['$','R/W',undef],  # input file name
      _sfr              => ['$','R/W',1],      # skip first row: yes 
      _ifs              => ['$','R/W','|'],    # input field separator
      _ofs              => ['$','R/W','|'],    # output field separator
      _ofn              => ['$','R/W',''],     # output file name
      _odf              => ['$','R/W',''],     # output def file name
      _def_arrayref     => ['$','R',''],       # column def array ref
      _dat_arrayref     => ['$','R',''],       # data array ref
    );
    # class methods, to operate on encapsulated class data
    # is a specified object attribute accessible in a given mode
    sub _accessible {
        my ($self, $attr, $mode) = @_;
        my $c = substr($mode, 0, 1);
        my $m = $_attr_data{$attr}[1]; $m =~ s /\//\|/g;
        # print "$mode, $c, $m\n"; 
        return $c =~ /($m)/i if exists $_attr_data{$attr};
    }
    # classwide default value for a specified object attributes
    sub _default_for {
        my ($self, $attr) = @_;
        return $_attr_data{$attr}[2] if exists $_attr_data{$attr};
    }
    sub _accs_type {
        my ($self, $attr) = @_;
        return $_attr_data{$attr}[0] if exists $_attr_data{$attr};
    }
    # list of names of all specified object attributes
    sub _standard_keys { keys %_attr_data; }
}

sub new {
    my $caller        = shift;
    my $caller_is_obj = ref($caller);
    my $class         = $caller_is_obj || $caller;
    my $self          = bless {}, $class;
    my %arg           = @_;   # convert rest of inputs into hash array
    # populate the references to hash or even overwrite them 
    # if they are defined in the input hash
    foreach my $attrname ( $self->_standard_keys() ) {
        my ($argname) = ($attrname =~ /^_(.*)/);
        if (exists $arg{$argname}) { 
            $self->{$attrname} = $arg{$argname};
        } elsif ($caller_is_obj) {
            $self->{$attrname} = $caller->{$attrname};
        } else {
            $self->{$attrname} = $self->_default_for($attrname);
        }
    }
    my $als='input_file_name,input_field_sep,input_field_separator';
    $als .= ',output_field_sep,output_field_separator,';
    $als .= 'output_def_file,output_definition_file,set_dfn,';
    $als .= 'definition_file_name,skip_first_row,debug';
    foreach my $a ( split /,/, $als ) {
        if (exists $arg{$a} && $self->can($a)) { 
           $self->$a($arg{$a}); 
        }
    }
 
    # my $i = "";
    # foreach $i (sort keys %arg) { print "$i=$arg{$i}\n"; }
    # foreach $i (sort keys %{$self}) { print "$i=${$self}{$i}\n"; }
    return $self;
}

# destructor adjusts class count
sub DESTROY {  
    my ($self) = @_;
    # clean up base classes
    return if !@ISA;
    foreach my $parent (@ISA) {
        next if $self::DESTROY{$parent}++;
        my $destructor = $parent->can("DESTROY");
        $self->$destructor() if $destructor;
    }
}

sub skip_first_row {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_sfr}=shift) : return $s->{_sfr};
}

sub input_field_sep {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_ifs}=shift) : return $s->{_ifs};
}

sub input_field_separator {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_ifs}=shift) : return $s->{_ifs};
}

sub output_field_sep {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_ofs}=shift) : return $s->{_ofs};
}

sub output_field_separator {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_ofs}=shift) : return $s->{_ofs};
}

 
sub input_file_name {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_ifn}=shift) : return $s->{_ifn};
}

 
sub output_file_name {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_ofn}=shift) : return $s->{_ofn};
}

 
sub output_def_file {
    my $s = shift;
    croak "ERR: Too many args to input_file_name." if @_ > 1;
    @_ ? ($s->{_odf}=shift) : return $s->{_odf};
}

sub output_definition_file { 
    my $s = shift; return $s->output_def_file(@_);
}

sub definition_file_name { 
    my $s = shift; return $s->output_def_file(@_);
}

sub set_dfn { 
    my $s = shift; return $s->output_def_file(@_);
}

sub get_dfn { 
    my $s = shift; return $s->output_def_file(@_);
}

# implement other get_... and set_... method (create as neccessary)
sub AUTOLOAD {
    no strict "refs";
    my ($self, $v1, $v2) = @_;
    (my $sub = $AUTOLOAD) =~ s/.*:://;
    my $m = $sub;
    (my $attr = $sub) =~ s/^(get|set)//;
        $attr = "$attr";
    # print join "|", $self, $v1, $v2, $sub, $attr,"\n";
    my $type = $self->_accs_type($attr);
    croak "ERR: No such method: $AUTOLOAD.\n" if !$type;
    my  $v = "";
    my $msg = "WARN: no permission to change";
    if ($type eq '$') {           # scalar method
        $v  = "\n";
        $v .= "    my \$s = shift;\n";
        $v .= "    croak \"ERR: Too many args to $m.\" if \@_ > 1;\n";
        if ($self->_accessible($attr, 'write')) {
            $v .= "    \@_ ? (\$s->{$attr}=shift) : ";
            $v .= "return \$s->{$attr};\n";
        } else {
            $v .= "    \@_ ? (carp \"$msg $m.\n\") : ";
            $v .= "return \$s->{$attr};\n";
        }
    } elsif ($type eq '@') {      # array method
        $v  = "\n";
        $v .= "    my \$s = shift;\n";
        $v .= "    my \$a = \$s->{$attr}; # get array ref\n";
        $v .= "    if (\@_ && (ref(\$_[0]) eq 'ARRAY' ";
        $v .= "|| \$_[0] =~ /.*=ARRAY/)) {\n";
        $v .= "        \$s->{$attr} = shift; return;\n    }\n";
        $v .= "    my \$i;     # array index\n";
        $v .= "    \@_ ? (\$i=shift) : return \$a;\n";
        $v .= "    croak \"ERR: Too many args to $m.\" if \@_ > 1;\n";
        if ($self->_accessible($attr, 'write')) {
            $v .= "    \@_ ? (\${\$a}[\$i]=shift) : ";
            $v .= "return \${\$a}[\$i];\n";
        } else {
            $v .= "    \@_ ? (carp \"$msg $m.\n\") : ";
            $v .= "return \${\$a}[\$i];\n";
        }
    } else {                      # assume hash method: type = '%'
        $v  = "\n";
        $v .= "    my \$s = shift;\n";
        $v .= "    my \$a = \$s->{$attr}; # get hash array ref\n";
        $v .= "    if (\@_ && (ref(\$_[0]) eq 'HASH' ";
        $v .= " || \$_[0] =~ /.*=HASH/)) {\n";
        $v .= "        \$s->{$attr} = shift; return;\n    }\n";
        $v .= "    my \$k;     # hash array key\n";
        $v .= "    \@_ ? (\$k=shift) : return \$a;\n";
        $v .= "    croak \"ERR: Too many args to $m.\" if \@_ > 1;\n";
        if ($self->_accessible($attr, 'write')) {
            $v .= "    \@_ ? (\${\$a}{\$k}=shift) : ";
            $v .= "return \${\$a}{\$k};\n";
        } else {
            $v .= "    \@_ ? (carp \"$msg $m.\n\") : ";
            $v .= "return \${\$a}{\$k};\n";
        }
    }
    $self->echoMSG("sub $m {$v}\n",100);
    *{$sub} = eval "sub {$v}";
    goto &$sub;
}

sub describe {
    my $self     = shift;
    my ($inf,$def,$out,$sfr,$ifs,$ofs,$nrc,$owt,$chr) = @_;
    $inf = $self->get_ifn if !$inf;
    croak "ERR: no input file/array is specified.\n" if !$inf;
    $self->echoMSG("  - describing $inf...");
    $sfr = $self->get_sfr   if !$sfr; 
    $sfr = 'N' if !$sfr;    # default skip first row to 'N'
    $ifs = $self->get_ifs   if !$ifs;
    $ifs = '\|' if !$ifs;   # default input field sep to '|'
    $ofs = $self->get_ofs   if !$ofs; 
    $ofs = '\|' if !$ofs;   # default output field sep to '|'
    $nrc = 0   if !$nrc;    # default sample records to 0 (all)
    # $dfs = '/' if !$dfs;  # default dir separator to '/'
    $owt = 'N' if !$owt;    # default overwrite to 'N'
    $chr = '"' if !$chr;    # default quote character to '"'
    my ($fhi, @data); 
    if ($inf =~ /ARRAY/) {
        @data = @{$inf};
    } else { 
        croak "ERR: input file does not exist.\n"  if (!-f $inf);
        $fhi = new IO::File "<$inf";   # input file handler
        croak "ERR: could not open file - $inf.\n" if (!defined($fhi));
        @data = <$fhi>;
        undef $fhi;
    }
    #
    # read the data and process it
    my(@a, @b, $j, $n, $c, $v, $msg);
    my @A=();         # store field definition information
    my @D=();         # store possible date field information
    my $max_nf = 0;   # max number of fields
    my $i = -1;
    my $drf = bless [], ref($self)||$self;
    foreach (@data) {
        # skip empty and comment lines
        next if (!$_ || $_ =~ /^\s+$/ || $_ =~ /^#/);
        ++$i; chomp;
        @a = split /$ifs/, $_, 99999;
        $max_nf = ($#a+1>$max_nf)? $#a+1 : $max_nf;
        if ($chr) {
            for $j (0..$#a) { next if !$a[$j];
                $a[$j] =~ s/^\s*//;   # remove leading spaces
                $a[$j] =~ s/\s*$//;   # remove trailing spaces
                $a[$j] =~ s/^($chr)*//;  # remove leading quote char
                $a[$j] =~ s/($chr)*?$//;  # remove trailing quote char
            }
        }
        if ($i==0) {             # define column names
            if ($sfr =~ /^Y$/i || $sfr == 1) {
                # get column names from the first row
                for $j (0..$#a) {
                    if (!$a[$j] || $a[$j] =~ /^\s*$/) {
                        $A[$j]{'col'} = sprintf "FLD%03d", $j+1;
                    } else      {
                        $A[$j]{'col'} = $a[$j];
                    }
                }
                next;            # skip the first column
            } else {             # generate seq column names
                for $j (0..$#a) {
                    $A[$j]{'col'} = sprintf "FLD%03d", $j+1;
                }
            }
            for $j (0..$#A) {
                ${$drf}[0][$j] = $A[$j]{col};
            }
        }
        push(@{$drf}, [@a]);
        for $j (0..$#a) {     # loop thru fields
            $v = $a[$j];         # value in the field
            if (!defined($A[$j]{'max'})) { $A[$j]{'max'} = -1; }
            if (!defined($A[$j]{'min'})) { $A[$j]{'min'} = 9999999; }
            if (!defined($A[$j]{'typ'})) { $A[$j]{'typ'} = ""; }
            if (!defined($A[$j]{'dft'})) { $A[$j]{'dft'} = ""; }
            if (!defined($A[$j]{'dsp'})) { $A[$j]{'dft'} = ""; }
            if (!defined($A[$j]{'dec'})) { $A[$j]{'dec'} = 0; }
            if ($A[$j]{'max'}<length($v)){ $A[$j]{'max'}=length($v); }
            if ($A[$j]{'min'}>length($v)){ $A[$j]{'min'}=length($v); }
            if (!$A[$j]{'typ'} || $A[$j]{'typ'} ne 'C') {
                if ($v =~ /^-?[\d\.]*$/) {     # it is numerical
                    $A[$j]{'typ'} = 'N';
                } elsif ($v =~ /^[\d \/\.]*$/ ) {   # it is date?
                    $A[$j]{'typ'} = 'D';
                    @b = split /\//, $v;
                    # first date field
                    if (!defined($D[$j][1]{min})) {
                        $D[$j][1]{min} = 999999;
                    }
                    # if (!exists $D[$j][1]{min}) {
                    #     $D[$j][1]{min} = 999999;
                    # }
                    if (!defined($D[$j][1]{max})) {
                    # if (!exists $D[$j][1]{max}) {
                        $D[$j][1]{max} = -1;
                    }
                    $D[$j][1]{min} = ($D[$j][1]{min}>$b[0]) ? $b[0] :
                         $D[$j][1]{min};
                    $D[$j][1]{max} = ($D[$j][1]{max}<$b[0]) ? $b[0] :
                         $D[$j][1]{max};
                     # second date field
                    if (!exists $D[$j][2]{min}) {
                 
                        $D[$j][2]{min} = 999999;
                    }
                    if (!exists $D[$j][2]{max}) {
                        $D[$j][2]{max} = -1;
                    }
                    $D[$j][2]{min} = ($D[$j][2]{min}>$b[0]) ? $b[1] :
                         $D[$j][2]{min};
                    $D[$j][2]{max} = ($D[$j][2]{max}<$b[0]) ? $b[1] :
                         $D[$j][2]{max};
                     # third date field
                    if (!exists $D[$j][3]{min}) {
                        $D[$j][3]{min} = 999999;
                    }
                    if (!exists $D[$j][3]{max}) {
                        $D[$j][3]{max} = -1;
                    }
                    $D[$j][3]{min} = ($D[$j][3]{min}>$b[0]) ? $b[2] :
                         $D[$j][3]{min};
                    $D[$j][3]{max} = ($D[$j][3]{max}<$b[0]) ? $b[2] :
                         $D[$j][3]{max};
                } else {
                    $A[$j]{'typ'} = 'C';
                }
            }
            if ($A[$j]{'typ'} eq 'N') {   # it is numeric
                if (!defined($A[$j]{'dec'})) { $A[$j]{'dec'} = 0; }
                @b = split /\./, $v;
                if (!defined($b[1])) { $b[1] = ""; } # so no warning
                if ($A[$j]{'dec'}<length($b[1])) {   # max decimal
                    $A[$j]{'dec'} = length($b[1]);   # length
                }
            }
        }   # end of for $j (...)
    }   # end of while(<$fhi>)
    my $tot = $i;  if ($sfr !~ /^Y$/i) { $tot = $i+1; }
    my $tcn = $#A+1;
    my ($mx1, $mx2, $mx3, $mn1, $mn2, $mn3);
    for $i (0..$#A) {
        if ($A[$i]{'min'}>0) { $A[$i]{'req'} = 'NOT NULL';
        } else {               $A[$i]{'req'} = "" }
        $A[$i]{'col'} =~ s/^\s*//;      # trim leading spaces
        $A[$i]{'col'} =~ s/\s*$//;      # trim ending spaces
        $A[$i]{'dsp'} = $A[$i]{'col'};
        $A[$i]{'col'} =~ s/[ \/]/_/ig;  # convert space and / to _
        # determine date format
        if ($A[$i]{typ} =~ /^D/i) {
            $mn1 = $D[$i][1]{min}; $mx1 = $D[$i][1]{max};
            $mn2 = $D[$i][2]{min}; $mx2 = $D[$i][2]{max};
            $mn3 = $D[$i][3]{min}; $mx3 = $D[$i][3]{max};
            $A[$i]{dft} = $self->get_date_format("$mn1:$mx1",
                 "$mn2:$mx2", "$mn3:$mx3");
        }
    }
    for $j (0..$max_nf) {
        next if ($A[$j]{'col'});
        if (!$A[$j]{'typ'}) { splice(@A, $j, 1); next; }
        $A[$j]{'col'} = sprintf "FLD%03d", $j+1;
    }
    $self->{_def_arrayref} = \@A;
    $self->{_dat_arrayref} = $drf; 
    $self->echoMSG("      Total records processed: $tot",2);
    $self->echoMSG("      Total columns created: $tcn",2);
}

sub output {
    my $self = shift;
    my ($arf, $out, $otp, $ifn, $ofs, $owt) = @_;
    # Input variables:
    #   $arf - array ref
    #   $out - output file name
    #   $otp - output type: data or definition
    #   $ifn - input file name as name reference
    #   $ofs - output field separator
    #   $owr - whether to overwrite existing file
    #
    $self->echoMSG('WARN: nothing to be outputed') if (!$arf && !$otp);
    $otp = 'def' if !$otp;
    if ($otp =~ /^def/i) {            # column definition array ref
        $arf = $self->get_def_arrayref if !$arf;
        $out = $self->get_odf          if !$out;
    } else {
        $arf = $self->get_dat_arrayref if !$arf;
        $out = $self->get_ofn          if !$out;
    }
    $self->echoMSG('WARN: no input array defined') if !$arf;
    return if !$arf;
    $owt = 'N' if !$owt; 
    $ofs = $self->get_ofs if !$ofs;
    #
    # let's determine output file name
    $ifn = $self->get_ifn if !$ifn;
    my $ds = '/'; 
    $ifn = 'dsbf.dat' if !$ifn;
    my ($bnm,$dir,$type)=fileparse($ifn,'\.\w+$');
    my $fho = ""; 
    if (!$out) {
        $fho = *STDOUT;
    } elsif ($out =~ /^Y/i) {
        if ($otp =~ /^def/i) {    
            $out =  "$dir${bnm}.def";
        } else {
            $out =  "$dir${bnm}.dat";
        }
        $self->echoMSG("  - outputing to $out..."); 
        if ($owt eq 'Y' && $out && -f $out) { unlink $out; }
        carp "WARN: file - $out exist.\n" if -f $out;
        $fho = new IO::File ">$out";   # output file hanlder
        croak "ERR: could not write to $out.\n" if (!defined($fho));
    }

    if ($otp =~ /^def/i) {    
        # ColName|ColType|ColWidth|ColRequirement|DateFmt|ColLabel
        my ($t1, $t2, $t3); 
        $t1  = "# Input  file name: $ifn\n" if $ifn;
        $t1  = "# Input  file name: $arf\n" if !$ifn;
        $t1 .= "# Output file name: $out\n";
        $t1 .= "# Created at " . (scalar localtime) . "\n";
        $t1 .= "# Created by Data::Describe::output\n#";
        $t2  = "# ColName|ColType|ColWidth|ColRequirement|DateFmt|";
        $t2 .= "ColLabel";
        my ($rec,$wid,$dsp,$typ);
        print $fho "$t1\n$t2\n";
        for my $i (0..$#{$arf}) {
            $wid = 0; $typ = ${$arf}[$i]{'typ'};
            if (${$arf}[$i]{'wid'}) { $wid = ${$arf}[$i]{'wid'};
            } else { $wid = ${$arf}[$i]{'max'}; }
            if ($typ eq 'N') { $wid = "$wid.${$arf}[$i]{'dec'}"; }
            if (!defined(${$arf}[$i]{'dsp'})) {
                ${$arf}[$i]{'dsp'} = "";
            } else { $dsp = ${$arf}[$i]{'dsp'}; }
            $rec = join $ofs, ${$arf}[$i]{'col'},$typ,
                $wid,${$arf}[$i]{'req'},${$arf}[$i]{'dft'}, $dsp;
            print $fho "$rec\n";
        }
    } else {
        foreach (@{$arf}) {
            print $fho (join $ofs, @{$_}) . "\n";
        }
    }
    undef $fho;
}

sub debug {
    # my ($c_pkg,$c_fn,$c_ln) = caller;
    # my $s =  ref($_[0])?shift:(bless {}, $c_pkg);
    my $s =  shift;
    croak "ERR: Too many args to debug." if @_ > 1;
    @_ ? ($s->{_debug}=shift) : return $s->{_debug};
}

sub echoMSG {
    my $self = shift;
    my ($msg,$lvl,$yn) = @_;
    if (!defined($msg)) { return; }      # return if no msg
    if (!defined($lvl)) { $lvl = 0; }    # default level to 0
    return $msg if $yn;
    my $class = ref($self)||$self;       # get class name
    my $dbg = $self->debug;              # get debug level
    if (!$dbg) { return; }               # return if not debug
    my $ref = ref($msg);
    return if ($lvl > $dbg );
    if ($ref eq $class) {                # an array? 
        # $self->disp_param($msg);
    } else { print "$msg\n"; }
}

sub get_date_format {
    my $self = shift;
    my ($r1, $r2, $r3, $ds) = @_;
    # Input variables:
    #   $r1 - date range 1: 'min:max'
    #   $r2 - date range 2: 'min:max'
    #   $r3 - date range 3: 'min:max'
    #   $ds - date separator
    #
    my ($mn1, $mx1) = split /:/, $r1;
    my ($mn2, $mx2) = split /:/, $r2;
    my ($mn3, $mx3) = split /:/, $r3;
    $ds = '/' if !$ds;
    my ($msg, $dft, $d1, $d2, $d3) = ("", "", "", "", "");
    if (($mn1>31 && $mx1<=99) || ($mn1>99 && $mx1<10000)) {
        # 1st fd is YY or YYYY
        if ($mn1>31 && $mx1<=99) {      # 1st fd is YY
            $d1 = 'YY';
        } else { $d1 = 'YYYY'; }        # 1st fd is YYYY
        if ($mn2>=1 && $mx2<=12) {      # 2nd fd is MM
            $d2 = 'MM';
        } elsif ($mn2>=1 && $mx2<=31) { # 2nd fd is DD
            $d2 = 'DD';
        }
        if ($d1 eq 'MM' && $mn3>=1 && $mx3<=12) {  # 3rd fd is DD
            $d3 = 'DD';
        } elsif ($mn3>=1 && $mx3<=12) { # 3rd fd is MM
            $d3 = 'MM';
        } elsif ($mn3>=1 && $mx3<=31) {  # 3rd fd is DD
            $d3 = 'DD';
        }
    } elsif ($mn1>=1 && $mx1<=12) {     # 1st fd is MM
        $d1 = 'MM';
        if ($mx2>31 && $mx2<=99) {          # 2nd fd is YY
            $d2 = 'YY';
        } elsif ($mx2>99 && $mx2<10000) {   # 2nd fd is YYYY
            $d2 = 'YY';
        } elsif ($mn2>=1 && $mx2<=31) {     # 2nd fd is DD
            $d2 = 'DD';
        }
        if ($d2 eq 'DD' && $mx3<=99) {      # 3nd fd is YY
            $d3 = 'YY';
        } elsif ($mn3>31 && $mx3<=99) {     # 3nd fd is YY
            $d3 = 'YY';
        } elsif ($mn3>99 && $mx3<10000) {   # 3nd fd is YYYY
            $d3 = 'YYYY';
        } elsif ($mn3>=1 && $mx3<=31) {     # 3nd fd is DD
            $d3 = 'DD';
        }
    } elsif ($mn1>=1 && $mx1<=31) {     # 1st fd is DD
        $d1 = 'DD';
        if ($mx2>31 && $mx2<=99) {          # 2nd fd is YY
            $d2 = 'YY';
        } elsif ($mx2>99 && $mx2<10000) {   # 2nd fd is YYYY
            $d2 = 'YY';
        } elsif ($mn2>=1 && $mx2<=12) {     # 2nd fd is MM
            $d2 = 'MM';
        }
        if ($d2 eq 'MM' && $mx3<=99) {      # 3nd fd is YY
            $d3 = 'YY';
        } elsif ($mx3>31 && $mx3<=99) {     # 3nd fd is YY
            $d3 = 'YY';
        } elsif ($mx3>99 && $mx3<10000) {   # 3nd fd is YYYY
            $d3 = 'YYYY';
        } elsif ($mn3>=1 && $mx3<=12) {     # 3nd fd is MM
            $d3 = 'MM';
        }
    } else {                                # 1st fd is YY (32~99)?
        $d1 = 'YY';
        if ($mn2>=1 && $mx2<=12) {      # 2nd fd is MM
            $d2 = 'MM';
        } elsif ($mn2>=1 && $mx2<=31) { # 2nd fd is DD
            $d2 = 'DD';
        }
        if ($d1 eq 'MM' && $mn3>=1 && $mx3<=12) {  # 3rd fd is DD
            $d3 = 'DD';
        } elsif ($mn3>=1 && $mx3<=12) { # 3rd fd is MM
            $d3 = 'MM';
        } elsif ($mn3>=1 && $mx3<=31) {  # 3rd fd is DD
            $d3 = 'DD';
        }
    }
    if ($d1 && $d2 && $d3 && ($d1 ne $d2) && ($d2 ne $d3)) {
        $dft = join $ds, $d1, $d2, $d3;
    } else {
        $msg = "illegal date: $d1($r1), $d2($r2), $d3($r3)";
    }
    return ($dft) ? $dft : $msg;
}

1;   # ensure that the module can be successfully used.

__END__