use strict;
use warnings;
use Data::Dumper;

my @temp = ( [ qw( testthis 2000-4 2000-2 2000-1 2000-12 2001-1 2002-1
+2 1999-12 ) ], # bad
             [ qw( testthis 1999-1 1999-2 1999-3 1999-4 1999-5 1999-6 
+1999-7 1999-8 1999-9 1999-10 1999-11 1999-12 2001-3 ) ], # bad
             [ qw( 1999-1 1999-2 1999-3 1999-4 1999-5 1999-6 1999-7 19
+99-8 1999-9 1999-10 1999-11 1999-12 2000-1 ) ], # good
             [ qw( 1998-12 1999-1 ) ], # good
             [ qw( 2004-1 ) ], # good
             [ qw( 2004-12 ) ], # good
             [ qw( 2004-12 2004-11 ) ], # good
             [ qw( testthis 2004-12 2004-9 2004-11 ) ] ); # bad
foreach ( @temp ) {
    my %dates = map { $_, '' } @$_;
    if ( exists $dates{ 'testthis' } ) {
        delete $dates{ 'testthis' };
        print Dumper( \%dates );
        my ( $missing ) = find_gaps( \%dates );
        print Dumper( $missing ), '-' x 20 ,"\n";
    }
}

#
# Above is my test code.  Below is the code in question
#

sub find_gaps {
    my $dates = shift;
    my %year;

    # Create hash with years as keys and values being a list with 
    # first month and last month in that year range
    foreach my $date ( keys %$dates ) {
        my $this_year = substr $date, 0, 4;        
        next if exists $year{ $this_year };
        $year{ $this_year } = get_range( $this_year, \%$dates );
    }

    my @years = sort keys %year;
    my $gap = 0;
    my ( @missing, @present );
    
    # Year span is greater than number of years
    if ( scalar @years > 1 and ( ( $years[ -1 ] - $years[ 0 ] ) ) != (
+ scalar @years ) - 1 ) {
        for my $year ( $years[ 0 ] .. $years[ -1 ] ) {
            if ( ! grep { /$year/ } @years ) {
                for ( 1 .. 12 ) {
                    push @missing, "$year-$_";
                } # next month
            }
        } # next year
    }
    
    # Gap in months?
    for my $year_index ( 0 .. $#years ) {

        my $curr_year   = $years[ $year_index ];
        my $first_month = $year{ $curr_year }->[ 0 ];
        my $last_month  = $year{ $curr_year }->[ 1 ];

        next if $year_index == 0 and $first_month == 12;
        next if $year_index == $#years and $first_month == 1 and ! $la
+st_month;

        my ( $first, $last );

        # first year, but more than one year
        if ( $year_index == 0 and $#years != 0 ) {
            ( $first, $last ) = ( $first_month, 12 ); # first year
        # first and only year
        } elsif ( $year_index == 0 ) {
            ( $first, $last ) = ( $first_month, $last_month ? $last_mo
+nth : $first_month );
        #last year
        } elsif ( $year_index == $#years ) {
            ( $first, $last ) = ( 1, $last_month ? $last_month : $firs
+t_month ); # last year
        # intervening years
        } else {
            ( $first, $last ) = ( 1, 12 );
        }

        for my $month ( $first .. $last ) {
            if ( ! exists $dates->{ $curr_year."-".$month } ) {
                push @missing, $curr_year."-".$month;
            }
        } # next $month
    } # next $year_index
    return \@missing;
}

sub get_range {
    my ( $year, $dates ) = @_;
    my @months;

    # If the %date has the same year, grab the month    
    @months = sort { $a <=> $b }
              map  { substr( $_, 5 ) }
              grep { substr( $_, 0, 4 ) == $year } keys %$dates;

    # Return range if more than one month, else return the month
    $#months > 0 ? [ $months[ 0 ], $months[ -1 ] ] : [ $months[ 0 ], 0
+ ];
}
[download]

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.