File Coverage

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

Criterion	Covered	Total	%
statement	109	111	98.2
branch	12	18	66.6
condition			n/a
subroutine	13	13	100.0
pod	0	3	0.0
total	134	145	92.4

package Excel::Writer::XLSX::Shape;

###############################################################################
#
# Shape - A class for writing Excel shapes.
#
# 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 warnings;
use Carp;
use Exporter;

our @ISA     = qw(Exporter);
our $VERSION = '1.07';
our $AUTOLOAD;

###############################################################################
#
# new()
#
sub new {

    my $class      = shift;
    my $fh         = shift;
    my $self       = Excel::Writer::XLSX::Package::XMLwriter->new( $fh );

    my %properties = @_;

    $self->{_name} = undef;
    $self->{_type} = 'rect';

    # Is a Connector shape. 1/0 Value is a hash lookup from type.
    $self->{_connect} = 0;

    # Is a Drawing. Always 0, since a single shape never fills an entire sheet.
    $self->{_drawing} = 0;

    # OneCell or Absolute: options to move and/or size with cells.
    $self->{_editAs} = '';

    # Auto-incremented, unless supplied by user.
    $self->{_id} = 0;

    # Shape text (usually centered on shape geometry).
    $self->{_text} = 0;

    # Shape stencil mode.  A copy (child) is created when inserted.
    # The link to parent is broken.
    $self->{_stencil} = 1;

    # Index to _shapes array when inserted.
    $self->{_element} = -1;

    # Shape ID of starting connection, if any.
    $self->{_start} = undef;

    # Shape vertex, starts at 0, numbered clockwise from 12 o'clock.
    $self->{_start_index} = undef;

    $self->{_end}       = undef;
    $self->{_end_index} = undef;

    # Number and size of adjustments for shapes (usually connectors).
    $self->{_adjustments} = [];

    # Start and end sides. t)op, b)ottom, l)eft, or r)ight.
    $self->{_start_side} = '';
    $self->{_end_side}   = '';

    # Flip shape Horizontally. eg. arrow left to arrow right.
    $self->{_flip_h} = 0;

    # Flip shape Vertically. eg. up arrow to down arrow.
    $self->{_flip_v} = 0;

    # shape rotation (in degrees 0-360).
    $self->{_rotation} = 0;

    # An alternate way to create a text box, because Excel allows it.
    # It is just a rectangle with text.
    $self->{_txBox} = 0;

    # Shape outline colour, or 0 for noFill (default black).
    $self->{_line} = '000000';

    # Line type: dash, sysDot, dashDot, lgDash, lgDashDot, lgDashDotDot.
    $self->{_line_type} = '';

    # Line weight (integer).
    $self->{_line_weight} = 1;

    # Shape fill colour, or 0 for noFill (default noFill).
    $self->{_fill} = 0;

    # Formatting for shape text, if any.
    $self->{_format} = {};

    # copy of colour palette table from Workbook.pm.
    $self->{_palette} = [];

    # Vertical alignment: t, ctr, b.
    $self->{_valign} = 'ctr';

    # Alignment: l, ctr, r, just
    $self->{_align} = 'ctr';

    $self->{_x_offset} = 0;
    $self->{_y_offset} = 0;

    # Scale factors, which also may be set when the shape is inserted.
    $self->{_scale_x} = 1;
    $self->{_scale_y} = 1;

    # Default size, which can be modified and/or scaled.
    $self->{_width}  = 50;
    $self->{_height} = 50;

    # Initial assignment. May be modified when prepared.
    $self->{_column_start} = 0;
    $self->{_row_start}    = 0;
    $self->{_x1}           = 0;
    $self->{_y1}           = 0;
    $self->{_column_end}   = 0;
    $self->{_row_end}      = 0;
    $self->{_x2}           = 0;
    $self->{_y2}           = 0;
    $self->{_x_abs}        = 0;
    $self->{_y_abs}        = 0;

    # Override default properties with passed arguments
    while ( my ( $key, $value ) = each( %properties ) ) {

        # Strip leading "-" from Tk style properties e.g. -color => 'red'.
        $key =~ s/^-//;

        # Add leading underscore "_" to internal hash keys, if not supplied.
        $key = "_" . $key unless $key =~ m/^_/;

        $self->{$key} = $value;
    }

    bless $self, $class;
    return $self;
}


###############################################################################
#
# set_properties( name => 'Shape 1', type => 'rect' )
#
# Set shape properties.
#
sub set_properties {

    my $self       = shift;
    my %properties = @_;

    # Update properties with passed arguments.
    while ( my ( $key, $value ) = each( %properties ) ) {

        # Strip leading "-" from Tk style properties e.g. -color => 'red'.
        $key =~ s/^-//;

        # Add leading underscore "_" to internal hash keys, if not supplied.
        $key = "_" . $key unless $key =~ m/^_/;

        if ( !exists $self->{$key} ) {
            warn "Unknown shape property: $key. Property not set.\n";
            next;
        }

        $self->{$key} = $value;
    }
}


###############################################################################
#
# set_adjustment( adj1, adj2, adj3, ... )
#
# Set the shape adjustments array (as a reference).
#
sub set_adjustments {

    my $self = shift;
    $self->{_adjustments} = \@_;
}


###############################################################################
#
# AUTOLOAD. Deus ex machina.
#
# Dynamically create set/get methods that aren't already defined.
#
sub AUTOLOAD {

    my $self = shift;

    # Ignore calls to DESTROY.
    return if $AUTOLOAD =~ /::DESTROY$/;

    # Check for a valid method names, i.e. "set_xxx_Cy".
    $AUTOLOAD =~ /.*::(get|set)(\w+)/ or die "Unknown method: $AUTOLOAD\n";

    # Match the function (get or set) and attribute, i.e. "_xxx_yyy".
    my $gs        = $1;
    my $attribute = $2;

    # Check that the attribute exists.
    exists $self->{$attribute} or die "Unknown method: $AUTOLOAD\n";

    # The attribute value
    my $value;

    # set_property() pattern.
    # When a method is AUTOLOADED we store a new anonymous
    # sub in the appropriate slot in the symbol table. The speeds up subsequent
    # calls to the same method.
    #
    no strict 'refs';    # To allow symbol table hackery

    $value = $_[0];
    $value = 1 if not defined $value;    # The default value is always 1

    if ( $gs eq 'set' ) {
        *{$AUTOLOAD} = sub {
            my $self  = shift;
            my $value = shift;

            $value = 1 if not defined $value;
            $self->{$attribute} = $value;
        };

        $self->{$attribute} = $value;
    }
    else {
        *{$AUTOLOAD} = sub {
            my $self = shift;
            return $self->{$attribute};
        };

        # Let AUTOLOAD return the attribute for the first invocation
        return $self->{$attribute};
    }
}


###############################################################################
#
# _get_palette_color()
#
# Convert from an Excel internal colour index to a XML style #RRGGBB index
# based on the default or user defined values in the Workbook palette.
# Note: This version doesn't add an alpha channel.
#
sub _get_palette_color {

    my $self    = shift;
    my $index   = shift;
    my $palette = $self->{_palette};

    # Adjust the colour index.
    $index -= 8;

    # Palette is passed in from the Workbook class.
    my @rgb = @{ $palette->[$index] };

    return sprintf "%02X%02X%02X", @rgb[0, 1, 2];
}


1;

__END__