#!/usr/bin/perl


use strict;
use warnings;

BEGIN {
  chdir "/home/bram/libnew";

  my %Modules = ();
  my %Export  = ();

  opendir DIR, "." or die "Can't open dir: $!";

  while (my $dir = readdir (DIR)) {
    next, if ($dir =~ m/^\.*$/);
    next, if ($dir =~ m/^Axoni/);
    next, if ($dir =~ m/^Development/);
    next, if ($dir =~ m/^Site/);

  
    my @files = qx/find $dir -name '*.pm'/;
    for my $file (@files) {
      chomp $file;
 
      my $f = $file;
      $f =~ s#^$dir/##g;

      $Modules{$f} = 1;


      open FH, "<", $file or die $!;
      while (<FH>) {
        # Looking for @EXPORT = qw(...) or @EXPORT = () ...  (broken! for example: @EXPORT = qw// or push @EXPORT, "")

        if (m/^\s*\@EXPORT\s*=\s*(?:qw)?\(\s*(.+?)\s*\);/) {
          push @{ $Export{$f} }, $1;
        }
      } 
      close FH;
    }
  }
  closedir DIR;

#use Data::Dumper;
#print Dumper \%Modules;
#die;


 
  unshift @INC, sub {
    my ($s, $f) = @_;
    my $f2 = $f;
    $f2 =~ s#/#::#g;
    $f2 =~ s#\.pm$##g;

    if (defined $Modules{$f}) {
      # Laad AutoLoad module
      print STDERR "SETUPING UP AUTOLOAD MODULE FOR $$ : $f\n";
      
      open my $fh, "<", "/home/bram/libnew/Development/LoadModule.pm" or die "Unable to load file (LoadModule.pm): $!";
      return ($fh, sub {
        s/^\s*package\s*LoadModule;/package $f2;/g;
        if ($_ eq "### \@EXPORT_ALL placeholder ###\n" and exists $Export{$f}) {
          $_ = 'push @EXPORT_ALL, qw/' . join(" ", @{ $Export{$f} }) . '/;';
        }
#        print;
        return length $_;
      });
    }
    return undef;
  }
}

1;

$ cat Development/LoadModule.pm 

package LoadModule;

use strict;
use warnings;

use Development::Tie::Scalar;
use Development::Tie::Array;
use Development::Tie::Hash;
use Development::Tie::Handle;

 
use Carp;

our @EXPORT_ALL    = qw//;
### @EXPORT_ALL placeholder ###


sub AUTOLOAD {
  our $AUTOLOAD;

  my $c = __find_class();
  my $p = __PACKAGE__;
 
  
  print STDERR "AUTOLOADING: $p & $c & $AUTOLOAD & @_\n";

  if (defined $c) {
    if ( my ($function) = $AUTOLOAD =~ m/^${p}::(.*)$/ ) {
      my $p = $c . "::" . $function;
      if ($p eq 'Frame::Services::Data::Menu::field') {
        print STDERR "SKIPPING GOTO: $p\n";
        return;
      }
      print STDERR "GOTO: $p\n";
      goto &$p;
    }
  }

  else {
    warn "No clue about the calling module so we need to handle things ourself...";
  }
}



sub import {
  my $self = shift;


  
#  print STDERR  "IMPORT " . scalar(caller(0)) . "\n";
  my $c = __find_class();
#  print STDERR  "IMPORT-2: $c\n";


  if (defined $c) {
    my $x = $c->can("import");
    if ($x) {
      unshift @_, $c;
      goto &$x;
    }
  }

  else {
    my $dest = caller(0);

    no strict qw/refs/;

    my @list = @_;
    @list = @EXPORT_ALL, unless (@list);

    for (@list) {
#      print;
      my $v = $dest . "::" . substr($_, 1);

      if    (substr ($_, 0, 1) eq '&') {
        #CODE
        my $f = __PACKAGE__ . "::" . substr($_, 1);
        
        *{ $v } = sub { goto &$f; };
      }
 
      elsif (substr ($_, 0, 1) eq '$') {
        my $scalar;
        tie $scalar, "Development::Tie::Scalar", __PACKAGE__, substr($_, 1);

        *{ $v } = \$scalar;
      }
      elsif (substr ($_, 0, 1) eq '@') {
        my @array;
        tie @array, "Development::Tie::Array", __PACKAGE__, substr($_, 1);

        *{ $v } = \@array;
      }

      elsif (substr ($_, 0, 1) eq '%') {
        my %hash;
        tie %hash, "Development::Tie::Hash", __PACKAGE__, substr($_, 1);

        *{ $v } = \%hash;
      }

      elsif (substr ($_, 0, 1) eq '*') {
        # EXPORT HANDLE

      }

      else {

        my $f = __PACKAGE__ . "::" . substr($_, 1);
        
        *{ $v } = sub { goto &$f; };

      }
    }

    warn "No clue about the calling module when importing!";
  }
  1;
} 

sub DESTROY { }

sub __find_caller {
  my $i = 0;

  while (defined scalar(caller($i)) and scalar(caller($i)) !~ m/^Site::/) { 
    $i++;
  }

  return scalar(caller($i));
}


sub __find_class {
  my $c = __find_caller();


  my $Site = "";

  if (defined $c and $c =~ m/^Site::([^:]+)::/) {
    $Site = $1;
  }

  if ($Site) {
    my $p  = __PACKAGE__;
    my $p2 = $p;
    $p2   =~ s#::#/#g;
    Load($Site . "/" . $p2 .".pm", $p, $Site . "::" . $p);
    return $Site . "::" . $p;;

  }

  else {
    my $p = __PACKAGE__;
    if ((caller(1))[3] ne $p . '::import') {
      croak "(Error:) Caller ($c) is unknown.";
    }
    else {
#      carp "(Warning:) Caller ($c) is unknown.";
    }
  }

  return undef;
}


sub Load {
  my $file        = shift;
  my $old_package = shift;
  my $new_package = shift;



  return, if (exists $INC{$file});
  print STDERR "LOADING FILE ($$): $file: " . scalar (caller(0)) . " : " . scalar (caller(1))  ." \n";
#  print STDERR "TESTEKE: $INC{$file}\n";
#  $INC{$file} = "/home/bram/libnew/" . $file;
#  print STDERR "TESTEKE-2: $INC{$file}\n";

  open FH, "<", "/home/bram/libnew/$file" or warn "Error opening file: $file : $!";
  local $/;
  my $code = <FH>;
  close FH;

  $INC{$file} = "/home/bram/libnew/" . $file;

  {
    no strict;
    no warnings;

    $code =~ s/^(\s*package\s+)$old_package/${1}$new_package/g;
    eval $code;
    warn $file . ": " . $@ if $@;
  }

}


1;


$ cat Development/Tie/Array.pm  
package Development::Tie::Array;

use strict;
no strict qw/refs/;

use warnings;
use Carp;

sub __get_class {
  my ($package, $var) = @{ +shift };
  
  my $class = $package->__find_class();
  return $class . "::" . $var;
}


sub TIEARRAY {
  my $class   = shift;
  my $package = shift;
  my $var     = shift;

  croak "Arguments missing: package and/or var" unless (defined $package and defined $var);
  return bless [ $package, $var ] , $class;
}

sub FETCHSIZE {
  return scalar ( @{ __get_class(@_) } );
}

sub FETCH {
  return __get_class(@_)->[$_[1]];
}

sub CLEAR {
  @{ __get_class(@_) } = ();
}

sub EXTEND { }

sub STORESIZE {
  $#{ __get_class(@_) } = $_[1] - 1;
}

sub STORE {
  __get_class(@_)->[$_[1]] = $_[2];
}

sub SHIFT {
  shift @{ __get_class(@_) };
}

sub UNSHIFT {
  unshift @{ __get_class(shift) }, @_;
}

sub POP {
  pop @{ __get_class(@_) };
}

sub PUSH {
  push @{ __get_class(shift) }, @_;
}

sub SPLICE {
  my $self  = shift;
  my $class = __get_class($self);
  my $sz    = @{ $class };
  my $off   = @_ ? shift : 0;
  $off     += $sz if $off < 0;
  my $len   = @_ ? shift : $sz-$off;
  return splice(@{ $class }, $off, $len, @_);
}

sub EXISTS {
  exists __get_class(@_)->[$_[1]];
}

sub DELETE {
  delete __get_class(@_)->[$_[1]];
}

1;


$ cat Development/Tie/Hash.pm 
package Development::Tie::Hash;

use strict;
no strict qw/refs/;

use warnings;
use Carp;

sub __get_class {
  my ($package, $var) = @{ +shift };
  
  my $class = $package->__find_class();
  return $class . "::" . $var;
}


sub TIEHASH {
  my $class   = shift;
  my $package = shift;
  my $var     = shift;

  croak "Arguments missing: package and/or var" unless (defined $package and defined $var);
  return bless [ $package, $var ] , $class;
}


sub STORE {
  __get_class(@_)->{$_[1]} = $_[2];
}

sub FETCH { 
  __get_class(@_)->{$_[1]};
}

sub FIRSTKEY { 
  my $a = scalar keys %{ __get_class(@_) }; 
  each %{ __get_class(@_) }; 
}

sub NEXTKEY { 
  each %{ __get_class(@_) };
}

sub EXISTS { 
  exists __get_class(@_)->{$_[1]}; 
}

sub DELETE { 
  delete __get_class(@_)->{$_[1]};
}

sub CLEAR { 
  %{ __get_class(@_) } = () 
}

sub SCALAR { 
  scalar %{ __get_class(@_) }; 
}


1;


$ cat Development/Tie/Handle.pm 
package Development::Tie::Handle;

use strict;
no strict qw/refs/;

use warnings;
use Carp;


#sub AUTOLOAD {
#  our $AUTOLOAD;
#  print "Function $AUTOLOAD not yet implemented.";
#}

sub DESTROY { }

sub __get_class {
  my ($package, $var) = @{ +shift };
  
  my $class = $package->__find_class();
  return $class . "::" . $var;
}



sub TIEHANDLE {
  my $class   = shift;
  my $package = shift;
  my $var     = shift;

  croak "Arguments missing: package and/or var" unless (defined $package and defined $var);
  return bless [ $package, $var ] , $class;
}


sub EOF {
  eof( *{ __get_class(@_) } );
}

sub TELL {
  tell( *{ __get_class(@_) } );
}

sub FILENO {
  fileno( *{ __get_class(@_) } );
}

sub SEEK {
  seek( *{ __get_class(@_) }, $_[1], $_[2]);
}

sub CLOSE {
  close( *{ __get_class(@_) } );
}

sub BINMODE {
  @_ == 2 ?  binmode( *{ __get_class(@_) }, $_[1])  :  binmode( *{ __get_class(@_) } );
}

sub OPEN {
  @_ == 2 ? open( *{ __get_class(@_) }, $_[1])  :  open( *{ __get_class(@_) }, $_[1], $_[2] );
}


sub READ { 
  @_ == 3 ? read( *{ __get_class(@_) }, $_[1], $_[2])  :  read( *{ __get_class(@_) }, $_[1], $_[2], $_[3] );
}

sub READLINE {
  readline *{ __get_class(@_) };
}

sub GETC {
  getc *{ __get_class(@_) };
}

sub WRITE {
  my $fh = __get_class(@_);
  print $fh substr($_[1], 0, $_[2]);
}

=kkkkkkkk


sub WRITE
{
 my $fh = $_[0];
 print $fh substr($_[1],0,$_[2])
}

=cut


1;


$ cat Development/Tie/Scalar.pm 
package Development::Tie::Scalar;

use strict;
no strict qw/refs/;

use warnings;
use Carp;


sub TIESCALAR {
  my $class   = shift;
  my $package = shift;
  my $var     = shift;

  croak "Arguments missing: package and/or var" unless (defined $package and defined $var);
  return bless [ $package, $var ] , $class;
}

sub FETCH {
  return ${ __get_class(@_) };
}


sub STORE {
  my $self  = shift;
  my $value = shift;

  return ( ${ __get_class($self) } = $value );
}

sub __get_class {
  my ($package, $var) = @{ +shift };
  
  my $class = $package->__find_class();
  return $class . "::" . $var;
}


1;