# vim: ts=8 et sw=4 sts=4
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 Exporter qw(import);
use Carp qw(croak);
use warnings 'all';

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;
}


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 );
    }
}

GrianUtils::T::import();

package GrianUtils::T;
no strict 'refs';

sub Dumper {
    require Data::Dumper;
    goto &Data::Dumper::Dumper;
}

sub import {
    *{ caller(1) . '::Dumper' } = \&Dumper if caller(1);
}

sub AUTOLOAD {
    require Data::Dumper;
    Data::Dumper->import('Dumper');
    goto &Dumper;
}

1;