package Thirdlane::Boot::Local;
{

require Config;
require Cwd;

sub new {
    my ($this) = shift;
    my $self = { @_ };
    my ($class) = ref($this) || $this;
    bless($self,$class);

    $self->{root} = '/opt/thirdlane/perl_lib';
    symlink ($self->{root}, "/usr/libexec/webmin/asterisk/perl_lib");
    $self->{force_libs} //= ['/usr/libexec/webmin', '/usr/libexec/webmin/asterisk', '/usr/libexec/webmin/asterisk/extlib', $ENV{HOME} . '/workspace/pbxmanager/server/extlib'];

    $ENV{OPENSSL_PREFIX} = $self->{root} . '/local/usr';
    $ENV{OPENSSL_INCLUDE} = $ENV{OPENSSL_PREFIX} . '/include';
    $ENV{OPENSSL_LIB} = $ENV{OPENSSL_PREFIX} . '/lib';

    $ENV{DBD_MYSQL_CFLAGS} = '-I' . $ENV{OPENSSL_PREFIX} . '/include';
    $ENV{DBD_MYSQL_LIBS} = '-L' . $ENV{OPENSSL_PREFIX} . '/lib';
    $ENV{DBD_MYSQL_NOSSL} = 1;

    $ENV{LD_LIBRARY_PATH} = $self->{root} . '/local/usr/lib' . ($ENV{LD_LIBRARY_PATH} ? (':' . $ENV{LD_LIBRARY_PATH}) : '');
    $ENV{LD_RUN_PATH} = $self->{root} . '/local/usr/lib' . ($ENV{LD_RUN_PATH} ? (':' . $ENV{LD_RUN_PATH}) : '');
    $ENV{PKG_CONFIG_PATH} = $self->{root} . '/local/usr/lib/pkgconfig' . ($ENV{PKG_CONFIG_PATH} ? (':' . $ENV{PKG_CONFIG_PATH}) : '');

    $self->init_data();
    $self->init_inc() unless $self->{no_change_inc};
    return $self;
}

sub sys_incs { my $self = shift; (
    $Config::Config{sitearchexp},
    $Config::Config{sitelibexp},
    $Config::Config{archlibexp},
    $Config::Config{privlibexp}
) }

sub local_over_incs {
    my $self = shift;

    return @{ $self->{local_over_inc_var} } if exists $self->{local_over_inc_var};

    $self->{local_over_inc_var} = [ map { $self->var_dir($_) } (
	$self->cat_path($self->{root}, '/local/over/lib64')
    ) ];

    return @{ $self->{local_over_inc_var} };
}

sub local_incs {
    my $self = shift;

    return @{ $self->{local_inc_var} } if exists $self->{local_inc_var};

    $self->{local_inc_var} = [ map { $self->var_dir($_) } (
    $self->{root},
    @{ $self->{force_libs} },
    map { $self->cat_path($self->{root}, $_) } @{ $self->{lib_dirs} }
) ];

    unshift @{ $self->{local_inc_var} }, $self->local_over_incs;

    return @{ $self->{local_inc_var} };
}

sub file_name_is_absolute {
    my ($self, $file) = @_;
    return scalar($file =~ m|^/|s);
}

sub get_cwd {
    my $self = shift;
    return Cwd::getcwd();
}

sub canon_path {
    my ($self, $path) = @_;

    return unless defined  $path;

    $path =~ s|/{2,}|/|g;                            # xx////xx  -> xx/xx
    $path =~ s{(?:/\.)+(?:/|\z)}{/}g;                # xx/././xx -> xx/xx
    $path =~ s|^(?:\./)+||s unless $path eq "./";    # ./xx      -> xx
    $path =~ s|^/(?:\.\./)+|/|;                      # /../../xx -> xx
    $path =~ s|^/\.\.$|/|;                         # /..       -> /
    $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx

    return $path;
}

sub cat_file {
    my ($self, $directory, $file) = @_;

    if ( $directory ne '' && $file ne '' && substr( $directory, -1 ) ne '/' && substr( $file, 0, 1 ) ne '/' ) {
	$directory .= "/$file" ;
    } else {
	$directory .= $file ;
    }

    return $directory;
}

sub cat_path {
    my $self = shift;
    return $self->canon_path(join('/', @_, ''));
}

sub read_data {
    my $self = shift;
    my @package_data = map { chomp $_; $_ ? $_ : () } <DATA>;
    close DATA;
    return @package_data;
}

sub expand_path {
    my ($self, $path) = @_;

    my $arg = "$path";

    if ($arg eq '.') {
	$arg = $self->get_cwd;
	$self->debug("Conversion", $path, 'to', $arg);
    }
    elsif ($arg eq '..') {
	$arg = $self->get_cwd;
	my @dirs = split /\//, $arg;
	pop @dirs;
	$arg = $self->cat_path(@dirs);
	$self->debug("Conversion", $path, 'to', $arg);
    }

    $arg = ( -d $arg && -l $arg ) ? $self->canon_path( readlink( $arg ) ) : $arg;
    $self->debug("Conversion: ", $arg) if $arg ne $path;

    return ($path, $arg);
}

sub var_dir {
    my ($self, $path) = @_;

    my $arg = "$path";
    $arg = ( -d $arg && -l $arg ) ? $self->canon_path( readlink( $arg ) ) : $self->canon_path( $arg );

    return ($arg, grep { -e $_ and ( -d $_ or -l $_ ) } map { $self->cat_path($arg, $_) } @{ $self->{lib_subdirs} });
}

sub allow_inc {
    my ($self, $path) = @_;
    if ( grep { index($path, $_) != -1 } $self->sys_incs ) {
	return 0;
    }
    return 1;
}

sub init_data {
    my ($self) = @_;

    for ( $self->read_data() ) {
	if ( $self->file_name_is_absolute($_) ) {
	    push @{ $self->{lib_dirs} //= [] }, $_;
	} else {
	    push @{ $self->{lib_subdirs} //= [] }, $_;
	}
    }

    $self->debug("LIBS: ", join "\n", @{ $self->{lib_dirs} });
    $self->debug("LIB subdirs: ", join "\n",@{ $self->{lib_subdirs} });
}

sub init_inc {
    my ($self) = @_;

    $self->debug("Initial INC: ", join "\n", @INC, "\n");

    return undef if $self->{no_change_inc};

    if ( $self->{saved_inc} && ref $self->{saved_inc} eq "ARRAY" ) {
	push @INC, @{ $self->{saved_inc} };
    } else {
	$self->{saved_inc} = [ @INC ];
    }

    if ( $self->{no_sys_inc} ) {
#	eval "no lib '$_';" for $self->sys_incs;
    }

    require lib;
    lib->import($_) for $self->local_incs;

    $self->{perllib} //= $ENV{PERLLIB};
    $self->{perl5lib} //= $ENV{PERL5LIB};

    $ENV{PERLLIB} = join( ':', ( $self->local_incs, split ':', $self->{perllib} ) ) if $self->{perllib};
    $ENV{PERL5LIB} = join( ':', ( $self->local_incs, split ':', $self->{perl5lib} ) ) if $self->{perl5lib};

    @INC = map { $self->expand_path($_) } @INC;

    if ( $self->{no_sys_inc} ) {
	@INC = grep { $self->allow_inc($_) } @INC;
    }

    @INC = grep { ( -e $_ && ( -d $_ || -l $_ ) ) || ( ref($_) && "$self" ne "$_" ) } @INC;

    unshift @INC, $self->local_over_incs;

    my @incs; foreach my $inc_item ( @INC ) { push @incs, $inc_item unless grep { $inc_item eq $_} @incs } @INC = grep { ( -e $_ && ( -d $_ || -l $_ ) ) || ( ref $_ ) } @incs;

    unshift @INC, $self;

    @lib::ORIG_INC = @INC;
    lib->unimport();

    if ( !$self->check_self ) {
	@INC = grep { !(ref($_) && "$self" eq "$_") } @INC;
	$self->debug('Self reposition');
	unshift @INC, $self;
	$self->debug("INC reposition: ", join "\n", @INC, "\n");
    }

    $self->debug("Final INC:" . join "\n", @INC, "\n");
    return $self->{inc} = [ @incs ];
}

sub check_self {
    my $self = shift;
    return ref($INC[0]) && "$INC[0]" eq "$self" ? 1 : 0;
}

sub unique {
    my $self = shift;

    my %seen;
    my $undef;
    my @uniq = grep defined($_) ? !$seen{$_}++ : !$undef++, @_;

    return @uniq;
}

sub found_in_inc {
    my ($self, $filename) = @_;

    my $module = $filename;

    if ($filename =~ m/\:\:/) {
	$module =~ s!::!/!g;
	$module .= ".pm";
    }

    if ( my $module_cache = $INC{$module} ) {
	$self->debug("Found in Cache: ", $module, $INC{$module_cache});
	return undef;
    }

    foreach my $prefix ( $self->unique( $self->local_over_incs, $self->local_incs, @INC, $self->get_cwd(), '..', '.' ) ) {
	my $realfilename = $self->cat_file($prefix, $module);
	if (-f $realfilename) {
	    my $fh;
	    $self->debug("Found in INC: ", $module, $realfilename);
	    $INC{$module} = $realfilename;
	    return $fh if (open ($fh, "<", $realfilename));
	}
    }

#    $self->debug($module, "not found in INC: ", join ("\n", $self->unique( $self->local_over_incs, $self->local_incs, @INC, "\n" )), "PWD:", $self->get_cwd);

    return undef;
}

sub Thirdlane::Boot::Local::INC {
    my ($self, $filename) = @_;

    $self->debug("Requested: ", $filename);

    $self->debug("Self removed. Reinit INC.")->init_inc() unless $self->check_self();

    return undef if $ENV{NOLOADINC};

    if ( my $fh = $self->found_in_inc($filename) ) {
	if ($filename eq 'web-lib-funcs.pl') {
	    my $module = join '', <$fh>;
	    close $fh;

	    if (-f '/opt/thirdlane/perl_lib/lib/init_config.pl') {
		open ($fh, '<', '/opt/thirdlane/perl_lib/lib/init_config.pl');
		my $fixture = join '', <$fh>;
		close $fh;

		$fixture .= 'sub old_init_config {';
		$module =~ s{^sub\sinit_config\n\{$}{$fixture}msg;
#		$self->debug("Patched module: ", $module);
	    }

	    if (-f '/opt/thirdlane/perl_lib/lib/open_readfile.pl') {
		open ($fh, '<', '/opt/thirdlane/perl_lib/lib/open_readfile.pl');
		my $fixture = join '', <$fh>;
		close $fh;

		$fixture .= 'sub old_open_readfile {';
		$module =~ s{^sub\sopen_readfile\n\{$}{$fixture}msg;
#		$self->debug("Patched module: ", $module);
	    }


	    open($fh, "<", \$module);
	}

	return $fh;
    }

    return undef;
}

sub DESTROY {
    my $self = shift;

#    return if ${^GLOBAL_PHASE} ne 'DESTRUCT';
    return;

    if ( $ENV{RESTOREINC} ) {
	@INC = @{ $self->{saved_inc} };
	$self->debug("Restored INC: ", qq{@INC});
    }
}

sub debug_log {
    my ($self, @data) = @_;

    return $self unless $self->{debuglog};

    my $log_line = join ' ', (@data, "\n");

    open $log, ">>/var/log/thirdlane/sitecustomize.log" or return warn "Couldn't open file: $!";
    print $log $log_line;
    close $log;

    return $self;
}

sub debug {
    my ($self, @data) = @_;

    $self->debug_log(@data);

    return $self unless $self->{debug};

    my $log = join ' ', (@data, "\n");

    print STDERR $log;

    return $self;
}
}

my @script_exceptions = qw(
    perl_lib_bundle2
);

unless ( grep { index( $0, $_ ) != -1 } @script_exceptions ) {
    unshift @INC, Thirdlane::Boot::Local->new( debug => $ENV{DEBUG}, debuglog => $ENV{DEBUGLOG}, no_change_inc => $ENV{NOCHANGEINC}, no_sys_inc => $ENV{NOSYSINC}, root => $ENV{ROOT} ) unless $ENV{NOCHANGEINC};
}

if ( grep { index( $0, $_ ) != -1 } ('miniserv') ) {
    eval q/
INIT {
    $INC{"tiesession.pm"} = 1;
    package tiesession;

    require Storable;
    require Cache::Memcached::Fast::Safe;

    Storable->import();
    Cache::Memcached::Fast::Safe->import();

    use constant {
        MEMCACHED_SERVERS           => [q(127.0.0.1:11211)],
        MEMCACHED_SESSION_NAMESPACE => q(mses:)
    };

    our $session_memd = new Cache::Memcached::Fast::Safe({
        servers            => MEMCACHED_SERVERS,
        serialize_methods  => [ \&Storable::freeze, \&Storable::thaw ],
        namespace          => MEMCACHED_SESSION_NAMESPACE,
        utf8               => 1,
        compress_threshold => 10_000
    });

#    require Tie::Hash;
#    @ISA = qw(Tie::Hash);

    sub TIEHASH {
	my $storage = bless {}, shift;
	$storage;
    }
    sub FETCH {
	my $self = shift;
	my $key = shift;

	my $value = $session_memd->get($key);

	return $value;
	#return wantarray ? : ;
    }
    sub STORE {
	my $self = shift;
	my $key = shift;
	my $value = shift;
	$session_memd->set($key, $value);
    }
    sub DELETE {
	my $self = shift;
	my $key = shift;
	$session_memd->delete($key);
    }
    sub CLEAR {
	my $self = shift;
    }
    sub FIRSTKEY {
	my $self = shift;
	return undef;
    }
    sub NEXTKEY {
	my $self = shift;
	return undef;
    }

    package miniserv;
    use subs qw(dbmopen dbmclose);
    sub dbmopen (\[%@];$$) {
	tie %{@_[0]}, 'tiesession';
    }
    sub dbmclose (\[%@]) {
	untie %{@_[0]};
    }

}
    /;
}

1;

__DATA__
x86_64-linux-thread-multi
x86_64-linux-thread-multi/auto

perl5
perl5/auto
perl5/x86_64-linux-thread-multi
perl5/x86_64-linux-thread-multi/auto

perl5/lib
perl5/lib/auto
perl5/lib/x86_64-linux-thread-multi
perl5/lib/x86_64-linux-thread-multi/auto

perl5/5.10.0/x86_64-linux-thread-multi
perl5/5.10.0/x86_64-linux-thread-multi/auto
perl5/5.10.0

lib
lib/auto
lib/x86_64-linux-thread-multi
lib/x86_64-linux-thread-multi/auto

lib/perl5
lib/perl5/auto
lib/perl5/x86_64-linux-thread-multi
lib/perl5/x86_64-linux-thread-multi/auto

lib/perl5/5.10.0/x86_64-linux-thread-multi
lib/perl5/5.10.0/x86_64-linux-thread-multi/auto
lib/perl5/5.10.0

lib/local
lib/local/auto
lib/local/x86_64-linux-thread-multi
lib/local/x86_64-linux-thread-multi/auto
lib/local/lib
lib/local/lib/auto
lib/local/lib/x86_64-linux-thread-multi
lib/local/lib/x86_64-linux-thread-multi/auto
lib/local/lib/perl5
lib/local/lib/perl5/auto
lib/local/lib/perl5/x86_64-linux-thread-multi
lib/local/lib/perl5/x86_64-linux-thread-multi/auto

local
local/auto
local/x86_64-linux-thread-multi
local/x86_64-linux-thread-multi/auto
local/lib
local/lib/auto
local/lib/x86_64-linux-thread-multi
local/lib/x86_64-linux-thread-multi/auto
local/lib/perl5
local/lib/perl5/auto
local/lib/perl5/x86_64-linux-thread-multi
local/lib/perl5/x86_64-linux-thread-multi/auto
local/dist/lib/perl5
local/dist/lib/perl5/auto
local/dist/lib/perl5/x86_64-linux-thread-multi
local/dist/lib/perl5/x86_64-linux-thread-multi/auto

local/dist/core/lib64/perl5
local/dist/core/lib64/perl5/auto
local/dist/core/lib64/perl5/x86_64-linux-thread-multi
local/dist/core/lib64/perl5/x86_64-linux-thread-multi/auto

local/core/lib64/perl5
local/core/lib64/perl5/auto
local/core/lib64/perl5/x86_64-linux-thread-multi
local/core/lib64/perl5/x86_64-linux-thread-multi/auto

local/core/share/perl5
local/core/share/perl5/auto
local/core/share/perl5/x86_64-linux-thread-multi
local/core/share/perl5/x86_64-linux-thread-multi/auto

local/core/lib64/perl5/5.10.0/x86_64-linux-thread-multi
local/core/lib64/perl5/5.10.0/x86_64-linux-thread-multi/auto
local/core/lib64/perl5/5.10.0

/local/core/lib64
/local/core/share
/local/dist
/local/dist/lib
/local/lib
/dist
/dist/lib
/lib
