package GrianUtils;
use strict;
use warnings;
use Carp qw/carp croak/;
use Fcntl qw(:flock);
use File::Spec;
use Scalar::Util qw(refaddr reftype);
use List::Util qw(max); 
use base 'Exporter';
use Data::Dumper;
use warnings 'all';
BEGIN{
	no strict 'refs';
	*{caller()."::".$_} = \&Data::Dumper::Dumper for 'Dumper'; #for tests
}

our (@EXPORT, @EXPORT_OK);
our $msg;
@EXPORT_OK=qw(ref_mem_safe my_readdir my_readfile loose $msg total_sv);

*total_sv = \&Storable::AMF::Util::total_sv;
sub loose(&){
    my $sub = shift;
    my $have = total_sv();
    my $delta;

    { 
        my $c;
        &$sub() for 1;
    };
    return $delta unless $delta = $msg = total_sv() - $have;

    {
        my $c = &$sub();
    };
    return 0 if total_sv() - $have == $delta;
    return $delta unless $delta = $msg = total_sv() - $have;

    $have = total_sv();
    
    {
        my $c = &$sub();
    };
    return $delta = $msg = total_sv() - $have;
}

use Carp qw(croak);
#@$a = __PACKAGE__->my_items( 't/AMF0' );
sub my_items{
	my $self = shift;
	my $directory  = shift;
	croak "GrianUtils::my_items list context required" unless wantarray;
	my @dir_content ;
	@dir_content = GrianUtils->my_readdir( ($directory) );
	my %items;
	my %values;
	my %eval;
	for (@dir_content){
		m/.*[\/\\](.*)\.(.*)/ and $items{ $1}{$2} = $_ or next;
		my $val = $values{$1}{$2} = GrianUtils->my_readfile($_);
	}
	my @item =  map $items{$_}, sort keys %items;

	# set name property
	$_->{ (keys %$_)[0]} =~m/([-\.()\w]+)\./ and $_->{name} ||= $1 for @item;
	! $values{$_->{name}} && warn "No name for '".$_->{ (keys %$_)[0]} ."'"for @item; 

	#read package if ext is pack
	for (@item){
		if (keys %$_ == 2 && $_->{'pack'}){
			my $val  =  $values{$_->{name}} or next;
			%$_ = (%$_ , %{_unpack($val->{'pack'})});
			$_->{dump} = $_->{eval} unless defined $_->{dump};
		}
		else {
			my $item = $_;
			$_ ne 'name' and $item->{$_} = $values{ $item->{name}}{$_} for keys %$item;
		}
	}
	
	@item  = grep { defined $_->{dump}} @item;

	for my $item ( @item){
		my $eval = $item->{dump}||=$item->{eval};
		no strict;
		$item->{obj} = eval $eval;
		use strict;
		$item->{eval} = $eval;
		croak "$item->{name}: $@" if $@;
		if ( defined $item->{xml} ){
			$item->{eval_xml}  = $item->{xml};
			$item->{obj_xml}   = eval $item->{xml};
			croak "$item->{name}: $@" if $@;
		}
		else {
			$item->{eval_xml} = $item->{eval};
			$item->{obj_xml} = $item->{obj};
		}
	}
	return @item;
}

sub my_readdir{
	my $class = shift;
    my $dirname = shift;
	my $option  = shift || 'abs';
	opendir my $SP, $dirname
	  or die "Can't opendir $dirname for reading";
	if ($option eq 'abs') {
		return  map {File::Spec->catfile($dirname, $_)} grep { $_ !~ m/^\.\.?$/ } readdir $SP;
	}
	elsif( $option eq 'rel' ) {
		return map {$dirname ."/". $_}  grep { $_ !~ m/^\./ } readdir $SP;
	}
	else {
		carp "unknown option: $option. Available options are 'abs' or 'rel'";
		return ();
	}
}
sub my_readfile{
	my $class = shift;
    my $file = shift;
    my @dirs = @_;
	my $buf;
    $file = File::Spec->catfile(@_, $file);
	open my $filefh, "<", $file
	or die "Can't open file '$file' for reading";
    binmode($filefh);
	flock $filefh, LOCK_SH;
	read $filefh, $buf,  -s $filefh;
	flock $filefh, LOCK_UN;
	close ($filefh);
	return $buf;
}

BEGIN {
	our $pack = "(w/a)*";
	our @fixed_names = qw(eval amf0 amf3);
	sub _pack{
		my $hash = shift;
		my (@fixed) = delete @$hash{@fixed_names};
		#my $s = \ pack "N/aN/aN/a(N/aN/a)*", $eval, $amf0, $amf3, %$hash;    
		my $s = \ pack $pack, @fixed, %$hash;    
		@$hash{@fixed_names} = (@fixed);
		return $$s;
	}
	sub _unpack{
		my (@fixed, %rest);
		(@fixed[0..$#fixed_names], %rest) = unpack $pack, $_[0];
		@rest{@fixed_names} = (@fixed);
		return \%rest;    
	};
};

sub create_pack{
    my $class = shift;
    my $dir   = shift;
    my $name  = shift;
    my $value = shift;

    $dir=~s/[\/\\]$//;
    my $pack_name = File::Spec->catfile($dir, "$name.pack");
    my $sname = $pack_name;
    $sname =~ s/\.pack$//;
    our %folder;

    $folder{$sname} = $value;
    delete $folder{$sname}{'pack'};
    open my $fh, ">", $pack_name or die "can't create $pack_name";
    binmode($fh);
    print $fh _pack($folder{$sname});
    close($fh);            

}


sub abs2rel{
	my $class    = shift;
	my $abs_path = shift;
	my $base     = shift;
	$base=~s/[\\\/]$//;
	$base=~s/\\/\//g;
	$abs_path=~s/\\/\//g;
	if ($base eq '.'){
		$base=~s/^\.//g;
		$abs_path=~s/^\.\///g;
		return "./$abs_path";
	}
	print STDERR "path='$abs_path' base='$base'\n";
	carp "Path can't transformed to relative: path='$abs_path' base='$base'" unless substr($abs_path, 0, length($base)) eq $base;	
	return ".".substr($abs_path, length($base));
}

# not tested yet
sub rel2abs{
	my $class    = shift;
	my $rel_path = shift;
	my $base     = shift;
	$base=~s/[\\\/]$//;
	$rel_path=~s/^\.\///;	
	carp "Path isn't relative: path='$rel_path' base='$base'" if $rel_path=~/^[\\\/]/;	
	return File::Spec->catfile($base, $rel_path);
}

sub _all_refs_addr{
    my $c = shift;
    while(@_){
        my $item = shift;
        
        next unless refaddr $item;
        next if $$c{refaddr $item};
        #print refaddr $item, "\n";
        $$c{refaddr $item} = 1;
        if (reftype $item eq 'ARRAY'){
            _all_refs_addr($c, @$item);
        }
        elsif (reftype $item eq 'HASH') {
            _all_refs_addr($c, $_);
        }
        elsif (reftype $item eq 'SCALAR') {            
        }
        elsif (reftype $item eq 'REF'){
            _all_refs_addr($c, $$item)
        }
        else {
            croak "Unsupported type ". reftype $item;
        }
    }
    return keys %$c;
}
sub ref_mem_safe {
    my $sub              = shift;
    my $count_to_execute = shift || 400;
    my $count_to_be_ok   = shift || 50;

    my $nu = -1;
    my @addresses;
    my %addr;
    my $old_max = 0;
    for ( my $round = 1 ; $round <= $count_to_execute ; ++$round ) {
        my @seq = &$sub();
        push @seq, ( \my $b ), [], {}, [], {}, \my $a;
        my $new_max = max( _all_refs_addr( {}, @seq, ) );
        if ( $old_max < $new_max ) {
            $old_max = $new_max;
            $nu      = -1;
        }
        else {
            ++$nu;
        }
        return $round, $round if ( $nu > $count_to_be_ok );
        @seq = ();
    }
    return ( 0, "$nu/$count_to_be_ok, $count_to_execute" ) if wantarray;
    return 0;
}
sub my_create_file{
    my $class = shift;
    my $file = shift;
    my $content = shift;
    my $base = shift;
    my $usage = 'GrianUtils->my_create_file($file, $content, $base)...';
    warn "$usage: \$base not is option" unless $base;
    croak "$usage: double dot in \$file restricted" if $file=~m/\.\./;
    $base ||= '.';
    carp "$usage: \$base --- ($base) is not a directory" unless -d $base;
    my @r =  split "/", $file;
    my $lfile = pop @r;

    my $loc_folder = File::Spec->catfile($base, @r);
    if (-d -w $loc_folder) {
        my $loc_file;
        open my $fh, ">", $loc_file = File::Spec->catfile($base, $file) 
          or croak "$usage: Can't create file($loc_file)";
        binmode($fh);
        print $fh $content;
        close($fh);
    }
    elsif (-d _) {
        croak "$usage: Not writeable directory($loc_folder)";
    }
    else {
        # Generate path for

        my @folders;
        my $folder = $base;

        for my $r (@r){
            $folder = File::Spec->catfile($folder, $r);
            next if (-d $folder);
            mkdir($folder) 
                or croak "$usage: Can't create directory ($folder) for path($loc_folder)";
        }
        $class->my_create_file($file, $content, $base);
    }
}
1;