# -*- perl -*-
# $Id: //depot/prod/DOT/dev/test/lib/Perf/Utils.pm#1 $
#
## @author   dl-perf-qa@netapp.com
## @summary  Hodgepodge of subroutines used by various Perf modules and tests. 
##                     All subroutines should either not talk to the filer or rely on agnostic
##                     modules exclusively
## @status   public
##
## @pod here

package Perf::Utils;

use strict;
use warnings;
use Carp qw(confess);
use Data::Dumper;
use Tharn;
use Utils::Units qw(:constants);
use threads;
use threads::shared;

require Exporter;
our @ISA = qw(Exporter);
#
# Nothing gets exported by default
#
our @EXPORT_OK = qw(min max ceil floor as_string halfsize in_bytes in_blocks get_random_element
                    get_file_size get_random_elements get_uid deep_copy wait_for_scan ndmp_copy
                    printflag setflag compare configure_aggr_data_disk_activity wait_for_reclamation diff);

sub in_bytes($);
sub compare ($$;$);

sub ceil {
    my $z = int($_[0]);
    return $z if ($_[0] < 0.0 || $_[0] == $z);
    return $z+1.0;
}

sub floor {
    my $z = int($_[0]);
    return $z if ($_[0] >= 0.0 || $_[0] == $z);
    return $z-1.0;
}

sub min {
    #
    # Find out how many defined values we have
    #
    my @args;
    for my $arg (@_){
        if (defined($arg)){
            push @args,$arg;
        }
    }
    my $min = shift @args;
    if (@args){
        for my $a (@args){
            if ($a < $min){
                $min = $a;
            }
        }
    }
    return $min;
}


sub max {
    #
    # Find out how many defined values we have
    #
    my @args;
    for my $arg (@_){
        if (defined($arg)){
            push @args,$arg;
        }
    }
    my $max = shift @args;
    if (@args){
        for my $a (@args){
            if ($a > $max){
                $max = $a;
            }
        }
    }
    return $max;
}

sub as_string($;$) {
    my $dataref = shift;
    my $depth = shift;
    my $old_depth = $Data::Dumper::Maxdepth;
    
    # Stringify the reference
    $Data::Dumper::Indent = 1;
    $Data::Dumper::Sortkeys = 1;
    if ($depth){
        $Data::Dumper::Maxdepth = $depth;
    }
    my $string = Data::Dumper->Dump([$dataref],["dataref"]);
    $string =~ s/\$dataref\s=\s//;
    $string =~ s/;$//;
    if ($depth){
        $Data::Dumper::Maxdepth = $old_depth;
    }
    return $string;
}

sub in_bytes($) {
    my $s = shift;
    
    if (ref($s) eq 'ARRAY'){
        my @r;
        for my $a (@$s){
            push @r, in_bytes($a);
        }
        return @r;
    }
    else{
    
        if ($s =~ /(\d+)\s?(t|TB)$/){
            return $1 * 1024 * 1024 * 1024 * 1024;
        }
        if ($s =~ /(\d+)\s?(g|GB|GiB)$/){
            return $1 * 1024 * 1024 * 1024;
        }
        elsif ($s =~ /(\d+)\s?(m|MB)$/){
            return $1 * 1024 * 1024;
        }
        elsif ($s =~ /(\d+)\s?(k|KB)$/){
            return $1 * 1024;
        }
        elsif ($s =~ /(\d+)\s?(b|B)$/){
            return $1;
        }
        elsif($s =~ /^\d+$/){
            return $s;
        }
        else{
            confess "Unable to find unit for: $s";
            return $s;
        }
    }
}

sub in_blocks($) {
    return ceil(in_bytes(shift) / 4096.0);
}

#
# Return half of the specified size.
#
sub halfsize($) {
    my $size = shift;

    return floor($1 / 2) . $2
        if $size =~ m/^(\d+)\s*(g|GB|m|MB|k|KB|b|B)$/;

    return floor($1 / 2)
        if $size =~ m/^(\d+)$/;

    confess "Unable to find unit for $size";
}

sub get_random_element($) {
    my $data = shift;
    my ($i, $a) = get_random_elements($data,1);
    if (wantarray){
        return ($i->[0],$a->[0]);
    }
    else{
        return $a->[0];
    }
}

sub get_random_elements($$) {
    my $data = shift;
    my $count = shift;
    
    my $elements;
    my $indexes;
    my @data_keys;
    my $data_type = ref($data);
    if ($data_type eq 'HASH'){
        @data_keys = keys %$data;
    }
    elsif($data_type eq 'ARRAY'){
        @data_keys = @$data;
    }
    else{
        confess "Unable to get random element out of a '$data_type'";
    }
    while ($count){
        my $rand_idx = int(rand(scalar(@data_keys)));
        my $rand_key = $data_keys[$rand_idx];
        push @$indexes, $rand_idx;
        push @$elements, $rand_key;
        splice @data_keys,$rand_idx,1;
        $count --;
    }
    if (wantarray){
        return ($indexes, $elements);
    }
    else{
        return $elements;
    }
}

#
# Query filesystem and get size of file
#
sub get_file_size($){
    my $file_path = shift;
    if (!$file_path){
        confess "You must specify a file path";
    }
    if (! -e $file_path){
        confess "File/Directory '$file_path' does not exist";
    }
    my $out = `ls -ld $file_path`;
    print("$out \n");
    $out = `ls -l $file_path`;
    print("$out \n");    
    my @stats = stat($file_path);
    if (!@stats){
        confess "Unable to get size of '$file_path':$!";
    }
    else{
        return $stats[7];
    }
}

#
# Generates large random number
#
sub get_uid {
    my $uid = time;
    $uid .= int(rand(2**32));
    return $uid;
}
sub deep_copy($;@);
sub deep_copy($;@) {
    my $this = shift;
    my %args = @_;
    my $depth = $args{depth};
    my $current_level = $args{_level};
    
    if (!defined($current_level)){
        $current_level = 0;
    }
    
    # Return value
    my $ret;
    
    my $ref_this = ref $this;
    if ( ! $ref_this || (defined($depth) && $current_level == $depth) ) {
        $ret = $this;
    }
    elsif ($ref_this eq "ARRAY") {
        my @a = map deep_copy($_,depth=>$depth,_level=>$current_level + 1), @$this;
        my $r = eval{
            lock $this;
            my $tmp = &share([]);
            push @$tmp, @a;
            return $tmp;
        };
        if ($@){
            if ($@ =~ /lock can only be used on shared values/){
                $ret = \@a;
            }
            else{
                confess $@;
            }
        }
        else{
            $ret = $r;
        }
    }
    elsif ($ref_this eq "HASH") {
        my %h = map { $_ => deep_copy($this->{$_},depth=>$depth,_level=>$current_level + 1) } keys %$this;
        my $r = eval{
            lock $this;
            my $tmp = &share({});
            my @keys = keys %h;
            my @values = values %h;
            @{$tmp}{@keys} = @values;
            return $tmp;
        };
        if ($@){
            if ($@ =~ /lock can only be used on shared values/){
                $ret = \%h;
            }
            else{
                confess $@;
            }
        }
        else{
            $ret = $r;
        }
    }
    elsif ($ref_this eq "SCALAR") {
        my $unref = $$this;
        $ret = \$unref;
    }
    else {
        confess "Type '$ref_this' is not supported" ;
    }
    return $ret;
}

sub wait_for_scan {
    return _redirect_subroutine("wait_for_scan", @_);
}

sub ndmp_copy {
    return _redirect_subroutine("ndmp_copy", @_);  
}

sub printflag($$) {
    return _redirect_subroutine("printflag", @_);
}

sub setflag($$$) {
    return _redirect_subroutine("setflag", @_);
}


# From Data::Compare.pm - compares perl data structures
# Returns 0 if the structures differ, else returns 1.
sub compare ($$;$);
sub compare ($$;$) {
    confess "Usage: compare(x, y, [opts])\n" unless $#_ == 1 || $#_ == 2;

    my %been_there;
    my %handler;

    my $x = shift @_;
    my $y = shift @_;
    my $opts = (shift @_) || {};
    my $rval = '';

    if(!exists($opts->{recursion_detector})) {
        %been_there = ();
        $opts->{recursion_detector} = 0;
    }
    $opts->{recursion_detector}++;

    warn "Yaroo! deep recursion!\n" if($opts->{recursion_detector} == 99);
  
    if(
        (ref($x) && exists($been_there{$x}) && $been_there{$x} > 1) ||
        (ref($y) && exists($been_there{$y}) && $been_there{$y} > 1)
    ) {
        $rval = 0; # is this the right thing to do?
    } else {
        $been_there{$x}++ if(ref($x));
        $been_there{$y}++ if(ref($y));

        $opts->{ignore_hash_keys} = { map {
            ($_, 1)
        } @{$opts->{ignore_hash_keys}} } if(ref($opts->{ignore_hash_keys}) eq 'ARRAY');

        my $refx = ref $x;
        my $refy = ref $y;

        if(exists($handler{$refx}) && exists($handler{$refx}{$refy})) {
            $rval = &{$handler{$refx}{$refy}}($x, $y, $opts);
        } elsif(exists($handler{$refy}) && exists($handler{$refy}{$refx})) {
            $rval = &{$handler{$refy}{$refx}}($x, $y, $opts);
        }

        elsif(!$refx && !$refy) { # both are scalars
            if(defined $x && defined $y) { # both are defined
                $rval = $x eq $y;
            } else { $rval = !(defined $x || defined $y); }
        }
        elsif ($refx ne $refy) { # not the same type
            $rval = 0;
        }
        elsif ($x == $y) { # exactly the same reference
            $rval = 1;
        }
        elsif ($refx eq 'SCALAR' || $refx eq 'REF') {
            $rval = compare($$x, $$y, $opts);
        }
        elsif ($refx eq 'ARRAY') {
            if ($#$x == $#$y) { # same length
                my $i = -1;
                $rval = 1;
                for (@$x) {
            	    $i++;
      	            $rval = 0 unless compare($$x[$i], $$y[$i], $opts);
                }
            }
            else {
                $rval = 0;
            }
        }
        elsif ($refx eq 'HASH') {
            my @kx = grep { !$opts->{ignore_hash_keys}->{$_} } keys %$x;
            my @ky = grep { !$opts->{ignore_hash_keys}->{$_} } keys %$y; # heh, KY
            $rval = 1;
            $rval = 0 unless scalar @kx == scalar @ky;

            for (@kx) {
                next unless defined $$x{$_} || defined $$y{$_};
                $rval = 0 unless defined $$y{$_} && compare($$x{$_}, $$y{$_}, $opts);
            }
        }
        elsif($refx eq 'Regexp') {
            $rval = compare($x.'', $y.'', $opts);
        }
        elsif ($refx eq 'CODE') {
            $rval = 0;
        }
        elsif ($refx eq 'GLOB') {
            $rval = 0;
        }
        else { # a package name (object blessed)
            my ($type) = "$x" =~ m/^$refx=(\S+)\(/;
            if ($type eq 'HASH') {
                my %x = %$x;
                my %y = %$y;
                $rval = compare(\%x, \%y, $opts);
                $been_there{\%x}--; # decrement count for temp structures
                $been_there{\%y}--;
            }
            elsif ($type eq 'ARRAY') {
                my @x = @$x;
                my @y = @$y;
                $rval = compare(\@x, \@y, $opts);
                $been_there{\@x}--;
                $been_there{\@y}--;
            }
            elsif ($type eq 'SCALAR' || $type eq 'REF') {
                my $x = $$x;
                my $y = $$y;
                $rval = compare($x, $y, $opts);
                # $been_there{\$x}--;
                # $been_there{\$y}--;
            }
            elsif ($type eq 'GLOB') {
                $rval = 0;
            }
            elsif ($type eq 'CODE') {
                $rval = 0;
            }
            else {
                confess "Can't handle $type type.";
                $rval = 0;
            }
        }
    }
    $opts->{recursion_detector}--;
    return $rval;
}


sub configure_aggr_data_disk_activity {
    return _redirect_subroutine("configure_aggr_data_disk_activity", @_);
}

sub _redirect_subroutine {
    my $name = shift;
    my $full_name = "Perf::UtilsTemp::$name";
    eval {
        require Perf::UtilsTemp;
    };
    if ($@){
        confess "Subroutine $name is not supported in this release: $@";
    }
    if(!exists &$full_name){
        confess "Unable to find subroutine '$name' in package Perf::UtilsTemp";
    }
    no strict 'refs';
    return &$full_name(@_);
}

sub wait_for_reclamation {
    return _redirect_subroutine("wait_for_reclamation", @_);
}


# ------------------------------------------------------------------------------------
# diff - Creates a nest of the differences between the provided structures.
# diff \%hash1, \%hash2
# diff \@array1, \@array2
#
# If a conflict of types (with the same key) is encountered, the right-hand 
# structure is used.
# NOTE: Although this routine compares contents, it returns references to the 
# original hashes.
# Returns: undef, if no differences are found between the data structures, else 
#          returns a reference to the structure containing the nest of the differences.
# -------------------------------------------------------------------------------------

sub diff {
   my ($l,$r) = @_;
   if (ref($l) eq 'HASH') {
     return _diff_hashes( $l, $r );
   } elsif (ref($l) eq 'ARRAY') {
       return _diff_arrays( $l, $r );
   }
}

# ------------------------------------------------------------------------------
# _diff_hashes &HASH, &HASH
# 
# Difference between two hashes.
# ------------------------------------------------------------------------------

sub _diff_hashes {
   my ($l,$r) = @_;
   return unless ref($l) eq 'HASH';
   return unless ref($r) eq 'HASH';
   my $h = undef;
   my @lkeys = keys %$l;
   while( my $key = shift @lkeys ) {
     if( defined $r->{$key} ) {
       if( ref($l->{$key}) eq ref($r->{$key}) ) {
         if( ref($l->{$key}) eq 'HASH' ) {
           my $subh = _diff_hashes( $l->{$key}, $r->{$key} );
           $h->{$key} = $subh if $subh;
         } elsif( ref($l->{$key}) eq 'ARRAY' ) {
           my $suba = _diff_arrays( $l->{$key}, $r->{$key} );
           $h->{$key} = $suba if $suba;
         } else {
           $h->{$key} = $r->{$key} unless $l->{$key} eq $r->{$key};
         }
       } else {
         $h->{$key} = $r->{$key};
       }
     } else {
       $h->{$key} = $l->{$key};
     }
   }
   my @rkeys = keys %$r;
   while( my $key = shift @rkeys ) {
     $h->{$key} = $r->{$key} unless defined $l->{$key};
   }
   return $h;
}

# ------------------------------------------------------------------------------
# _diff_arrays &ARRAY, &ARRAY
# 
# Difference between two arrays.
# ------------------------------------------------------------------------------

sub _diff_arrays {
   my ($l,$r) = @_;
   return unless ref($l) eq 'ARRAY';
   return unless ref($r) eq 'ARRAY';
   my $a = undef;
   my $idx = 0;
   my $min = min( $#$l, $#$r );
   for( my $idx = 0; $idx <= $min; $idx++ ) {
     my $lval = $l->[$idx];
     my $rval = $r->[$idx];
     if( ref($lval) eq ref($rval) ) {
       if( ref($lval) eq 'HASH' ) {
         my $subh = _diff_hashes( $lval, $rval );
         push( @$a, $subh ) if $subh;
       } elsif( ref($rval) eq 'ARRAY' ) {
         my $suba = _diff_arrays( $lval, $rval );
         push( @$a, $suba ) if $suba;
       } else {
         push( @$a, $rval ) unless $lval eq $rval;
       }
     } else {
       push @$a, $rval;
     }
     $idx++;
   }
   if( $#$l > $#$r ) {
     foreach my $idx ( ($#$r + 1) .. $#$l ) {
       push @$a, $l->[$idx];
     }
   } else {
     foreach my $idx ( ($#$l + 1) .. $#$r ) {
         push @$a, $r->[$idx];
     }
   }
   return $a;
}


1;