File Coverage

blib/lib/Excel/Writer/XLSX/Utility.pm

Criterion	Covered	Total	%
statement	91	128	71.0
branch	22	42	52.3
condition	14	24	58.3
subroutine	18	23	78.2
pod	16	17	94.1
total	161	234	68.8

package Excel::Writer::XLSX::Utility;

###############################################################################
#
# Utility - Helper functions for Excel::Writer::XLSX.
#
#
# Used in conjunction with Excel::Writer::XLSX
#
# Copyright 2000-2020, John McNamara, [e-mail]
#
# Documentation after __END__
#

# perltidy with the following options: -mbl=2 -pt=0 -nola

use 5.008002;
use strict;
use Exporter;
use warnings;
use autouse 'Date::Calc'  => qw(Delta_DHMS Decode_Date_EU Decode_Date_US);
use autouse 'Date::Manip' => qw(ParseDate Date_Init);

our $VERSION = '1.07';

# Row and column functions
my @rowcol = qw(
  xl_rowcol_to_cell
  xl_cell_to_rowcol
  xl_col_to_name
  xl_range
  xl_range_formula
  xl_inc_row
  xl_dec_row
  xl_inc_col
  xl_dec_col
);

# Date and Time functions
my @dates = qw(
  xl_date_list
  xl_date_1904
  xl_parse_time
  xl_parse_date
  xl_parse_date_init
  xl_decode_date_EU
  xl_decode_date_US
);

our @ISA         = qw(Exporter);
our @EXPORT_OK   = ();
our @EXPORT      = ( @rowcol, @dates, 'quote_sheetname' );
our %EXPORT_TAGS = (
    rowcol => \@rowcol,
    dates  => \@dates
);


###############################################################################
#
# xl_rowcol_to_cell($row, $col, $row_absolute, $col_absolute)
#
sub xl_rowcol_to_cell {

    my $row     = $_[0] + 1;          # Change from 0-indexed to 1 indexed.
    my $col     = $_[1];
    my $row_abs = $_[2] ? '$' : '';
    my $col_abs = $_[3] ? '$' : '';


    my $col_str = xl_col_to_name( $col, $col_abs );

    return $col_str . $row_abs . $row;
}


###############################################################################
#
# xl_cell_to_rowcol($string)
#
# Returns: ($row, $col, $row_absolute, $col_absolute)
#
# The $row_absolute and $col_absolute parameters aren't documented because they
# mainly used internally and aren't very useful to the user.
#
sub xl_cell_to_rowcol {

    my $cell = shift;

    return ( 0, 0, 0, 0 ) unless $cell;

    $cell =~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/;

    my $col_abs = $1 eq "" ? 0 : 1;
    my $col     = $2;
    my $row_abs = $3 eq "" ? 0 : 1;
    my $row     = $4;

    # Convert base26 column string to number
    # All your Base are belong to us.
    my @chars = split //, $col;
    my $expn = 0;
    $col = 0;

    while ( @chars ) {
        my $char = pop( @chars );    # LS char first
        $col += ( ord( $char ) - ord( 'A' ) + 1 ) * ( 26**$expn );
        $expn++;
    }

    # Convert 1-index to zero-index
    $row--;
    $col--;

    return $row, $col, $row_abs, $col_abs;
}


###############################################################################
#
# xl_col_to_name($col, $col_absolute)
#
sub xl_col_to_name {

    my $col     = $_[0];
    my $col_abs = $_[1] ? '$' : '';
    my $col_str = '';

    # Change from 0-indexed to 1 indexed.
    $col++;

    while ( $col ) {

        # Set remainder from 1 .. 26
        my $remainder = $col % 26 || 26;

        # Convert the $remainder to a character. C-ishly.
        my $col_letter = chr( ord( 'A' ) + $remainder - 1 );

        # Accumulate the column letters, right to left.
        $col_str = $col_letter . $col_str;

        # Get the next order of magnitude.
        $col = int( ( $col - 1 ) / 26 );
    }

    return $col_abs . $col_str;
}


###############################################################################
#
# xl_range($row_1, $row_2, $col_1, $col_2, $row_abs_1, $row_abs_2, $col_abs_1, $col_abs_2)
#
sub xl_range {

    my ( $row_1,     $row_2,     $col_1,     $col_2 )     = @_[ 0 .. 3 ];
    my ( $row_abs_1, $row_abs_2, $col_abs_1, $col_abs_2 ) = @_[ 4 .. 7 ];

    my $range1 = xl_rowcol_to_cell( $row_1, $col_1, $row_abs_1, $col_abs_1 );
    my $range2 = xl_rowcol_to_cell( $row_2, $col_2, $row_abs_2, $col_abs_2 );

    return $range1 . ':' . $range2;
}


###############################################################################
#
# xl_range_formula($sheetname, $row_1, $row_2, $col_1, $col_2)
#
sub xl_range_formula {

    my ( $sheetname, $row_1, $row_2, $col_1, $col_2 ) = @_;

    $sheetname = quote_sheetname( $sheetname );

    my $range = xl_range( $row_1, $row_2, $col_1, $col_2, 1, 1, 1, 1 );

    return '=' . $sheetname . '!' . $range
}


###############################################################################
#
# quote_sheetname()
#
# Sheetnames used in references should be quoted if they contain any spaces,
# special characters or if they look like something that isn't a sheet name.
#
sub quote_sheetname {

    my $sheetname = $_[0];

    # Use Excel's conventions and quote the sheet name if it contains any
    # non-word character or if it isn't already quoted.
    if ( $sheetname =~ /\W/ && $sheetname !~ /^'/ ) {
        # Double quote any single quotes.
        $sheetname =~ s/'/''/g;
        $sheetname = q(') . $sheetname . q(');
    }

    return $sheetname;
}


###############################################################################
#
# xl_inc_row($string)
#
sub xl_inc_row {

    my $cell = shift;
    my ( $row, $col, $row_abs, $col_abs ) = xl_cell_to_rowcol( $cell );

    return xl_rowcol_to_cell( ++$row, $col, $row_abs, $col_abs );
}


###############################################################################
#
# xl_dec_row($string)
#
# Decrements the row number of an Excel cell reference in A1 notation.
# For example C4 to C3
#
# Returns: a cell reference string.
#
sub xl_dec_row {

    my $cell = shift;
    my ( $row, $col, $row_abs, $col_abs ) = xl_cell_to_rowcol( $cell );

    return xl_rowcol_to_cell( --$row, $col, $row_abs, $col_abs );
}


###############################################################################
#
# xl_inc_col($string)
#
# Increments the column number of an Excel cell reference in A1 notation.
# For example C3 to D3
#
# Returns: a cell reference string.
#
sub xl_inc_col {

    my $cell = shift;
    my ( $row, $col, $row_abs, $col_abs ) = xl_cell_to_rowcol( $cell );

    return xl_rowcol_to_cell( $row, ++$col, $row_abs, $col_abs );
}


###############################################################################
#
# xl_dec_col($string)
#
sub xl_dec_col {

    my $cell = shift;
    my ( $row, $col, $row_abs, $col_abs ) = xl_cell_to_rowcol( $cell );

    return xl_rowcol_to_cell( $row, --$col, $row_abs, $col_abs );
}


###############################################################################
#
# xl_date_list($years, $months, $days, $hours, $minutes, $seconds)
#
sub xl_date_list {

    return undef unless @_;

    my $years   = $_[0];
    my $months  = $_[1] || 1;
    my $days    = $_[2] || 1;
    my $hours   = $_[3] || 0;
    my $minutes = $_[4] || 0;
    my $seconds = $_[5] || 0;

    my @date = ( $years, $months, $days, $hours, $minutes, $seconds );
    my @epoch = ( 1899, 12, 31, 0, 0, 0 );

    ( $days, $hours, $minutes, $seconds ) = Delta_DHMS( @epoch, @date );

    my $date =
      $days + ( $hours * 3600 + $minutes * 60 + $seconds ) / ( 24 * 60 * 60 );

    # Add a day for Excel's missing leap day in 1900
    $date++ if ( $date > 59 );

    return $date;
}


###############################################################################
#
# xl_parse_time($string)
#
sub xl_parse_time {

    my $time = shift;

    if ( $time =~ /(\d+):(\d\d):?((?:\d\d)(?:\.\d+)?)?(?:\s+)?(am|pm)?/i ) {

        my $hours    = $1;
        my $minutes  = $2;
        my $seconds  = $3 || 0;
        my $meridian = lc( $4 || '' );

        # Normalise midnight and midday
        $hours = 0 if ( $hours == 12 && $meridian ne '' );

        # Add 12 hours to the pm times. Note: 12.00 pm has been set to 0.00.
        $hours += 12 if $meridian eq 'pm';

        # Calculate the time as a fraction of 24 hours in seconds
        return ( $hours * 3600 + $minutes * 60 + $seconds ) / ( 24 * 60 * 60 );

    }
    else {
        return undef;    # Not a valid time string
    }
}


###############################################################################
#
# xl_parse_date($string)
#
sub xl_parse_date {

    my $date = ParseDate( $_[0] );

    # Unpack the return value from ParseDate()
    my ( $years, $months, $days, $hours, undef, $minutes, undef, $seconds ) =
      unpack( "A4     A2      A2     A2      C        A2      C       A2",
        $date );

    # Convert to Excel date
    return xl_date_list( $years, $months, $days, $hours, $minutes, $seconds );
}


###############################################################################
#
# xl_parse_date_init("variable=value", ...)
#
sub xl_parse_date_init {

    Date_Init( @_ );    # How lazy is that.
}


###############################################################################
#
# xl_decode_date_EU($string)
#
sub xl_decode_date_EU {

    return undef unless @_;

    my $date = shift;
    my @date;
    my $time = 0;

    # Remove and decode the time portion of the string
    if ( $date =~ s/(\d+:\d\d:?(\d\d(\.\d+)?)?(\s+)?(am|pm)?)//i ) {
        $time = xl_parse_time( $1 );
    }

    # Return if the string is now blank, i.e. it contained a time only.
    return $time if $date =~ /^\s*$/;

    # Decode the date portion of the string
    @date = Decode_Date_EU( $date );
    return undef unless @date;

    return xl_date_list( @date ) + $time;
}


###############################################################################
#
# xl_decode_date_US($string)
#
sub xl_decode_date_US {

    return undef unless @_;

    my $date = shift;
    my @date;
    my $time = 0;

    # Remove and decode the time portion of the string
    if ( $date =~ s/(\d+:\d\d:?(\d\d(\.\d+)?)?(\s+)?(am|pm)?)//i ) {
        $time = xl_parse_time( $1 );
    }

    # Return if the string is now blank, i.e. it contained a time only.
    return $time if $date =~ /^\s*$/;

    # Decode the date portion of the string
    @date = Decode_Date_US( $date );
    return undef unless @date;

    return xl_date_list( @date ) + $time;
}


###############################################################################
#
# xl_decode_date_US($string)
#
sub xl_date_1904 {

    my $date = $_[0] || 0;

    if ( $date < 1462 ) {

        # before 1904
        $date = 0;
    }
    else {
        $date -= 1462;
    }

    return $date;
}


1;


__END__