File Coverage

blib/lib/Image/OrgChart.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Image::OrgChart;

use strict;
use GD;
use vars qw($VERSION $DEBUG);
require Exporter;


$VERSION = '0.20';

sub new {
    my ($pkg,@args) = @_;
    my %args;
    if ((scalar @args % 2) == 0) {
        %args = @args;
    }

    ## defaults
    my $self = {
        min_width      => 0,
        min_height     => 0,
        box_color      => [0,0,0],
        box_fill_color => [120,120,120],
        connect_color  => [0,0,0],
        text_color     => [0,0,0],
        bg_color       => [255,255,255],
        shadow_color   => [50,50,50],
        shadow         => 0,
        arrow_heads    => 0,
        fill_boxes     => 0,
        h_spacing      => 15,
        v_spacing      => 5,
        path_seperator => '/',
        font           => 'gdTinyFont',
        font_height    => 10,  ## ?
        font_width     => 5,   ## ?
        indent         => undef,
        _data          => {},
        _track         => {
            longest_name => 0,
            shortest_name => 100,
            deapest_path => 0,
            most_keys  => 0,
            total_boxes => 1,
            },
        _image_info    => {
            height    => 0,
            width     => 0,
            },
        color         => {
            ## used by allocateColor
        },
        data_type     => ( GD::Image->can('gif') ? 'gif' : 'png'),
    };

    ## from new() args
    for (keys %args) {
        $self->{$_} = $args{$_};
    }

    return bless($self,$pkg);
}

sub data_type {
    return shift->{data_type};
}

sub add {
    my ($self,$path) = @_;
    $path =~ s/^$self->{path_seperator}//;
    my @arr_path = split(/$self->{path_seperator}/,$path);
    warn("PATH($path) - ",join(',',@arr_path),"\n") if $DEBUG;
    my $curr = '$self->{_data}';
    my $depth = 0;
    foreach my $limb (@arr_path) {
         $curr .= "{'$limb'}";
         if (length($limb) > $self->{_track}{longest_name}) {
             $self->{_track}{longest_name} = length($limb);
         } elsif (length($limb) < $self->{_track}{shortest_name}) {
             $self->{_track}{shortest_name} = length($limb);
         }
    }
    warn("CREATING: $curr\n") if $DEBUG;
    eval("$curr = {} unless (exists $curr)");
    die $@ if $@;
}

sub set_hashref {
    my ($self,$href) = @_;
    $self->{_data} = $href;
}

sub add_hashref {
    my ($self,$href) = @_;
    foreach my $nkey (keys %{ $href }) {
        if ($self->{$nkey}) {
            &add_hashref($self->{$nkey},$href->{$nkey});
        } else {
            $self->{$nkey} = $href->{$nkey};
            if (length($nkey) > $self->{_track}{longest_name}) {
                $self->{_track}{longest_name} = length($nkey);
            } elsif (length($nkey) > $self->{_track}{shortest_name}) {
                $self->{_track}{shortest_name} = length($nkey);
            }
        }
    }
}

sub alloc_collors {
    my ($self,$image) = @_;
    $self->{color}{box_color} = $image->colorAllocate($self->{box_color}[0],$self->{box_color}[1],$self->{box_color}[2]);
    $self->{color}{box_fill_color} = $image->colorAllocate($self->{box_fill_color}[0],$self->{box_fill_color}[1],$self->{box_fill_color}[2]);
    $self->{color}{connect_color} = $image->colorAllocate($self->{connect_color}[0],$self->{connect_color}[1],$self->{connect_color}[2]);
    $self->{color}{text_color} = $image->colorAllocate($self->{text_color}[0],$self->{text_color}[1],$self->{text_color}[2]);
    $self->{color}{bg_color} = $image->colorAllocate($self->{bg_color}[0],$self->{bg_color}[1],$self->{bg_color}[2]);
}

sub alloc_fonts {
    my $self = shift;

    no strict 'refs';
    my $fnt = &{$self->{font}}();
    use strict 'refs';
    $self->{font_width} = $fnt->width;
    $self->{font_height} = $fnt->height;
    $self->{indent} ||= 5;
    $self->{indent} =  $self->{font_width}*$self->{indent};
    warn "GD::Font H/W ($self->{font}) : $self->{font_height}/$self->{font_width}\n" if $DEBUG;
}

sub draw_boxes {
    my ($self,$image) = @_;
    my ($ULx,$ULy) = (5,5); ## start with some padding
    $Image::OrgChart::S::CurrentY = $ULy;
    $Image::OrgChart::S::BaseX = $ULx;
    &_draw_one_row_box($self,$self->{_data},$image,$ULx,$ULy);
}


sub _draw_one_row_box {
    my ($self,$href,$image,$indentX,$indentY) = @_;
    my $ULx = $indentX;
    my $indent =  $self->{indent};
    my $creap = $self->{_tracked}{box_height} + $self->{v_spacing};
    foreach my $person (sort keys %{ $href }) {
        my $ULy = $Image::OrgChart::S::CurrentY;

        # CONNECTER (if we are a child)
        if ($Image::OrgChart::S::ParentX && ($ULx > $Image::OrgChart::S::BaseX) ) {
            ## connect
            $self->_con_boxes($image,[$Image::OrgChart::S::ParentX,$Image::OrgChart::S::ParentY-$creap],[$ULx,$ULy]);
        }

        # RECTANGLE
        if ($self->{shadow}) {
            $image->filledRectangle($ULx+3,$ULy+3,$ULx+3+$self->{_tracked}{box_width},$ULy+3+$self->{_tracked}{box_height},$self->{color}{shadow_color});
            $image->filledRectangle($ULx,$ULy,$ULx+$self->{_tracked}{box_width},$ULy+$self->{_tracked}{box_height},$self->{color}{bg_color});
            $image->rectangle($ULx,$ULy,$ULx+$self->{_tracked}{box_width},$ULy+$self->{_tracked}{box_height},$self->{color}{box_color});
            if ($self->{fill_boxes}) {
                $image->fill($ULx+1,$ULy+1,$self->{color}{box_fill_color});
            }
        } else {
            $image->rectangle($ULx,$ULy,$ULx+$self->{_tracked}{box_width},$ULy+$self->{_tracked}{box_height},$self->{color}{box_color});
            if ($self->{fill_boxes}) {
                $image->fill($ULx+1,$ULy+1,$self->{color}{box_fill_color});
            }
        }

        # STRING
        no strict 'refs';
        my $fnt = &{$self->{font}}();
        use strict 'refs';
        $image->string($fnt,$ULx+2,$ULy+2,$person,$self->{color}{text_color});

        # TRANSLATE
        $Image::OrgChart::S::CurrentY += $creap;

        # REPORTS
        my $report_cnt = scalar keys %{ $href->{$person} };
        if ($report_cnt > 0) {
            $Image::OrgChart::S::ParentX = $ULx;
            $Image::OrgChart::S::ParentY = $Image::OrgChart::S::CurrentY;
            $self->_draw_one_row_box($href->{$person},$image,$ULx+$indent,$Image::OrgChart::S::CurrentY);
            $Image::OrgChart::S::ParentX -= $indent;
            $Image::OrgChart::S::ParentY -= $creap;
        }
    }
}

sub _con_boxes {
    my ($self,$image,$from,$to) = @_;

    $to->[1] += ( $self->{_tracked}{box_height} / 2 );
    my $vert_x    = ( $from->[0] + ($self->{indent}/2));
    my $v_start_y = ( $from->[1] + $self->{_tracked}{box_height} );

    $self->_draw_line($image,[$vert_x,$v_start_y],[$vert_x,$to->[1]]); # vertical
    $self->_draw_line($image,[$vert_x,$to->[1]],[$to->[0],$to->[1]]);
}

sub _draw_line {
    my ($self,$image,$from,$to) = @_;
    $image->line($from->[0],$from->[1],$to->[0],$to->[1],$self->{color}{connect_color});
    if ($self->{arrow_heads}) {
        ## i only currently do Horizontal and Vertical lines, which makes
        ## directional calculations much easier
        if ($from->[0] == $to->[0]) {
            ## vert line
            if ($to->[1] > $from->[1]) {
                ## face up
                ###### not yet needed
            } else {
                ##  face down
                ###### not yet needed
            }
        } else {
            ## horiz line
            if ($to->[0] > $from->[0]) {
                ## face right
                $image->line($to->[0],$to->[1],$to->[0]-4,$to->[1]-2,$self->{color}{connect_color});
                $image->line($to->[0],$to->[1],$to->[0]-4,$to->[1]+2,$self->{color}{connect_color});
                $image->line($to->[0]-4,$to->[1]-2,$to->[0]-4,$to->[1]+2,$self->{color}{connect_color});
            } else {
                ##  face left
                ###### currently unused
                $image->line($to->[0],$to->[1],$to->[0]+2,$to->[1]+4,$self->{color}{connect_color});
                $image->line($to->[0],$to->[1],$to->[0]-2,$to->[1]+4,$self->{color}{connect_color});
                $image->line($to->[0]+2,$to->[1]+4,$to->[0]-2,$to->[1]+4,$self->{color}{connect_color});
            }
        }
    }
}

sub draw {
    my $self = shift;
    my $gd = $self->gd();

    my $dt = $self->{data_type};
    return $gd->$dt();
}

*as_image = *draw;

sub gd {
   my $self = shift;

    ## new image
    $self->alloc_fonts();
    $self->_calc_depth();
    $self->calc_image_info();
    my $height = ( $self->{min_height} > $self->{_image_info}{height} ? $self->{min_height}  : $self->{_image_info}{height} );
    my $width  = ( $self->{min_width} > $self->{_image_info}{width} ? $self->{min_width}  : $self->{_image_info}{width} );
    #printf("HxW = %dx%d\n",$height,$width);
    my $image = new GD::Image($width,$height);
    $self->alloc_collors($image);
    $image->fill(0,0,$self->{color}{bg_color});
    $self->draw_boxes($image);

    return $image;
}

sub _calc_depth {
    my $self = shift;
    $Image::OrgChart::S::total = $self->{_track}{deapest_path};
    $Image::OrgChart::S::Kcount = $self->{_track}{most_keys};
    $Image::OrgChart::S::Lname = $self->{_track}{longest_name};
    $Image::OrgChart::S::Sname = $self->{_track}{shortest_name};
    $Image::OrgChart::S::TBox = $self->{_track}{total_boxes};
    &_re_f_depth($self->{_data});
    $self->{_track}{most_keys} = $Image::OrgChart::S::Kcount;
    $self->{_track}{deapest_path} = $Image::OrgChart::S::total;
    $self->{_track}{longest_name} = $Image::OrgChart::S::Lname;
    $self->{_track}{shortest_name} = $Image::OrgChart::S::Sname;
    $self->{_track}{total_boxes} = $Image::OrgChart::S::TBox ;
    undef($Image::OrgChart::S::total);
    undef($Image::OrgChart::S::Kcount);
    undef($Image::OrgChart::S::Lname);
    undef($Image::OrgChart::S::Sname);
    undef($Image::OrgChart::S::TBox);
}

sub _re_f_depth {
    my $href = shift;
    my $indent = shift;
    $indent ||= 0;
    if ( $indent > $Image::OrgChart::S::total ) {
        $Image::OrgChart::S::total = $indent;
    }
    foreach my $key (keys %$href) {
        $Image::OrgChart::S::TBox++;
            if (length($key) > $Image::OrgChart::S::Lname) {
                $Image::OrgChart::S::Lname = length($key);
            } elsif (length($key) < $Image::OrgChart::S::Sname) {
                $Image::OrgChart::S::Sname = length($key);
            }
        my $value = $href->{$key};
        if (ref($value) eq 'HASH') {
            &_re_f_depth($value, $indent + 1);
            $Image::OrgChart::S::Kcount = ( (scalar keys %$href > $Image::OrgChart::S::Kcount) ? scalar keys %$href : $Image::OrgChart::S::Kcount );
        }
    }
}

sub calc_image_info {
    my $self = shift;
    $self->{_tracked}{box_width} = ( ( $self->{_track}{longest_name} * $self->{font_width} ) + 2);
    $self->{_tracked}{box_height} = ( $self->{font_height} + 2 );
    $self->{_image_info}{height} = ( ($self->{v_spacing} + $self->{_tracked}{box_height}) * $self->{_track}{total_boxes});
    $self->{_image_info}{width}  = ( ($self->{indent}+$self->{h_spacing}) * $self->{_track}{deapest_path})+$self->{_tracked}{box_width};
}

sub mid_point {
    my ($x1,$y1,$x2,$y2) = @_;
    my $X = (((_max($x1,$x2) - _min($x1,$x2))/2) + _min($x1,$x2));
    my $Y = (((_max($y1,$y2) - _min($y1,$y2))/2) + _min($y1,$y2));
    return [$X,$Y];
}

sub _min {
    my ($a,$b) = @_;
    return ( $a > $b ? $b : $a);
}

sub _max {
    my ($a,$b) = @_;
    return ( $a < $b ? $b : $a);
}

1;
__END__