#!/usr/bin/perl
# Decorator/Wrapper pattern (GoF). Perl example. 
use strict;
use warnings;

main();
exit;

sub main {
    my $printer =
        VerticalDecorator->new(
            ReverseDecorator->new( 
                PrettyArrayPrinter->new(
                    data     => [ [ 'a' .. 'f' ], [ 1 .. 6 ], [ 'g' .. 'l' ] ],
                    splitter => ' ',
                    format   => {
                        title => 'Data Title',
                    },
                )
            )
        );
    $printer->print_data();
}

{ # interface description (for Decorators and Components) (+ implementation)
package ArrayPrinter;
    sub new {
        my $class = shift;
        my %params = @_;
        return bless %params, $class;
    }

    sub print_data {
    }

    sub set_data {
        my $self = shift;
        my $ref = shift;
        $self->{'data'} = $ref;
    }

    sub get_data {
        my $self = shift;
        return $self->{data};
    }

}

{ # Concrete component SimpleArrayPrinter
package SimpleArrayPrinter;
use base 'ArrayPrinter';

    sub print_data {
        my $self = shift;
        for my $a ( @{ $self->get_data() } ) {
        }
    }

}
{ # Concrete component PrettyArrayPrinter
package PrettyArrayPrinter;
use base 'ArrayPrinter';
    use Data::Dumper;
    use Pretty::Table;

    sub print_data {
        my $self = shift;
        my $pt = Pretty::Table->new(
            %{ $self->{'format'} }
        );
        $pt->set_data_ref( $self->get_data() );
        print $pt->output();
    }

}
{ # Decorator's base class
package Decorator;
use base 'ArrayPrinter';
    sub new {
        my $class = shift;
        my $component = shift;
        my $self = bless { component => $component }, $class;
        return $self;
    }

    sub print_data {
        my $self = shift;
        $self->{component}->print_data();
    }

    sub set_data {
        my $self = shift;
        $self->{component}->set_data(@_);
    }

    sub get_data {
        my $self = shift;
        return $self->{component}->get_data(@_);
    }

}
{ # Concrete decorator: VerticalDecorator
package VerticalDecorator;
use base 'Decorator';
    use Data::Dumper;

    sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        $self->_vertical();
        return $self;
    }

    sub _vertical {
        my $self = shift;
        my @result;
        for my $a ( @{ $self->{component}->get_data() } ) {
            my $i = 0;
            for my $elem ( @{$a} ) {
                push @{ $result[$i] }, $elem;
                $i++;
            }
        }
        $self->{component}->set_data( @result );
    }

}
{ # Concrete decorator: ReverseDecorator
package ReverseDecorator;
use base 'Decorator';

    sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        $self->_reverse_data();
        return $self;
    }

    sub _reverse_data {
        my $self = shift;
        my @data;
        for my $a ( @{ $self->{component}->get_data() } ) {
            push @data, [ reverse @{$a} ];
        }
        $self->{component}->set_data( @data );
    }
}