File Coverage

blib/lib/Treemap/Input/Dir.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	11	14	78.5
condition	2	5	40.0
subroutine	10	11	90.9
pod	2	2	100.0
total	83	96	86.4

package Treemap::Input::Dir;

use 5.006;
use strict;
use warnings;
use Carp;

use File::Basename;

require Exporter;
require Treemap::Input;

our @ISA = qw( Treemap::Input Exporter );
our @EXPORT_OK = (  );
our @EXPORT = qw( );
our $VERSION = '0.01';

# ------------------------------------------
# Methods:
# ------------------------------------------
sub new
{
   my $classname = shift;
   my $self = $classname->SUPER::new( @_ );  # Call parent constructor
   $self->_init( @_ );  # Initialize child variables
   return $self;
}

sub _init
{
   my $self = shift;
   $self->{FOLLOW_SYMLINK} = $self->{FOLLOW_SYMLINK} || undef;
}

sub load
{
   my $self = shift;
   my( $path ) = @_;

   if ( $self->{ DATA } = $self->_load( $path ) )
   {
      return 1;
   }
   return 0;
}

# ------------------------------------------
# _load()
# ------------------------------------------
sub _load
{
   my $self = shift;
   my( $path ) = @_;
   my( $tree, $DH, @children, $size );

   @children = ();
   $size = 0;

   opendir( $DH, $path );

   while( my $dir_entry = readdir( $DH ) )
   {
      next if( $dir_entry =~ /^\.{1,2}$/ );

      my $item;
      my $filename = "$path/$dir_entry";

      # Skip Sympbolic Links
      if( !$self->{FOLLOW_SYMLINK} && -l $filename )
      {
         next;
      }

      if( -d $filename )
      {
         $item = $self->_load( $filename );
         $item->{name} = basename( $item->{name} );
      }
      elsif( -f $filename )
      {
         ( $item->{size}, my $mtime ) = (stat( $filename ))[7,9];
         $item->{name} = $dir_entry;

         $item->{colour} = $self->_colour_by_mtime( $mtime );
      }
      else
      {
         next;
      }
      push( @children, $item );
      $size += $item->{size};
   }
   close( $DH );

   $tree->{name} = $path;
   $tree->{size} = $size;
   $tree->{colour} = "#FFFFFF";
   $tree->{children} = \@children if( scalar(@children) > 0 );

   return $tree;
}

sub _colour_by_mtime
{
   my $self = shift;
   my $mtime = shift;
   my $ctime = time;

   my $age = 1 + ( $ctime - $mtime ) / ( 60 * 60 );
   my $level = int ( log( $age ) * 10 );

   $level = 100 if ( $level > 100 );

   $level = int( 255 * ( $level / 100 ));

   return sprintf("#%02X%02X%02X", 255-$level, 0, $level );
}

sub _colour_by_type
{
   my $self = shift;
   my $ext  = shift;

   $ext =~ m/(\w)(\w)?(\w)?/;
}

1;

__END__