view release on metacpan or  search on metacpan

lib/AI/MicroStructure.pm  view on Meta::CPAN

#!/usr/bin/perl
package AI::MicroStructure;
use strict;
use warnings;
use Carp;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Digest::SHA1  qw(sha1 sha1_hex sha1_base64);
use Try::Tiny;
use File::Basename;
use File::Spec;
use File::Glob;
use Data::Dumper;
use Data::Printer;
use AI::MicroStructure::Util;
use Carp qw(croak);
our $absstructdir = "";
our $structdir = "";
our $VERSION = '0.20';
our $Structure = 'any'; # default structure
our $CODESET = 'utf8';
our $LANG = '';
our %MICRO;
our %MODS;
our %ALIEN;
our $str = "[A-Z]";
our $special = "any";
our $search;
our $data={};
our $item="";
our @items;
our @a=();
our ($init,$new,$drop,$available,$lib,
     $list,$use,$off,$switch,$mirror,
     $version,$help,$write,$verbose)  = (0,0,0,0,0,0,0,0,0,0,0,0,0,0);
eval "\$$_=1; " for @ARGV;
if( grep{/\bnew\b/} @ARGV ){ $new = 1; cleanArgs("new"); }
if( grep{/\bwrite\b/} @ARGV ){ $write = 1; cleanArgs("write");  };
if( grep{/\bdrop\b/} @ARGV ){ $drop = 1; cleanArgs("drop");  };
if( grep{/\bverbose\b/} @ARGV ){ $verbose = 1; cleanArgs("verbose");  };
our $StructureName = $ARGV[0]; # default structure
our $structure = $ARGV[0]; # default structure
our $state  = AI::MicroStructure::Util::config();
our @CWD=();
push @CWD ,  $state->{path}->{"cwd/structures"};
our $config = $state->{cfg};
our $micro = AI::MicroStructure->new($Structure);
$absstructdir = $state->{path}->{"cwd/structures"};
sub cleanArgs{
   my ($key) = @_;
   my @tmp=();
   foreach(@ARGV){
   push @tmp,$_ unless($_=~/$key/);}
   @ARGV=@tmp;
}
# private class method
sub find_structures {
   my ( $class, @dirs ) = @_;
   $ALIEN{"base"} =  [map  @$_,
   map  { [ ( fileparse( $_, qr/\.pm$/ ) )[0] => $_ ] }
   map  { File::Glob::bsd_glob(
   File::Spec->catfile( $_, ($structdir,"*") ) ) } @dirs];
   return @{$ALIEN{"base"}};
}

# fetch the list of standard structures
sub find_modules {
 my $structures = {};
   foreach(@INC)
   {
   my @set =  grep /($str)/,   map  @$_,
   map  { [ ( fileparse( $_, qr/\.pm$/ ) )[0] => $_ ] }
   map  { File::Glob::bsd_glob(
     File::Spec->catfile( $_, qw( AI MicroStructure *.pm ) ) ) } $_;
   foreach(@set){
   $structures->{$_}=$_;# unless($_=~/(usr\/local|basis)/);
   }
  }
  return %$structures;
}
$MICRO{$_} = 0 for keys %{{__PACKAGE__->find_structures(@CWD)} };
$MODS{$_} = $_ for keys %{{__PACKAGE__->find_modules(@INC)} };
$search = join("|",keys %MICRO);


BEGIN{
use File::HomeDir;
my $fileDir = File::HomeDir->my_home . "/data-hub/structures/";
my $fileSpec = File::HomeDir->my_home . "/data-hub/structures/any.pm";
if ( -e $fileSpec ) {


} else {
    mkdir($fileDir);
    warn "missing:$fileSpec";

}

}

sub getComponents{
  my $x= {};
  $x->{"all_structures"} = [keys %MICRO];
  $x->{"count_struct"} = sprintf(keys %MICRO);
  $x->{"structures"} = {};

     foreach my $con (@{$x->{"all_structures"}}){
      next unless($con!~/any/);
      my @in = split("\n",eval{`cat $state->{path}->{"cwd/structures"}/$con.pm`;});

      $x->{"structures"}->{$state->{path}->{"cwd/structures"}}->{$con}->{name} =
        [grep{$_}grep {!/(our|my|use|sub|use|package|#|__|1)/}split("\n",`cat $state->{path}->{"cwd/structures"}/$con.pm`)];#,

      $x->{"structures"}->{$state->{path}->{"cwd/structures"}}->{$con}->{files}  =
       [split("\n",`ls -R  /home/santex/repos/KnowledgeInterDisciplinary/data/json | egrep -i "($con)";`)];
    }

 return $x;
}
sub import {
    my $class = shift;
    my @structures = ( grep { $_ eq ':all' } @_ )
      ? ( 'foo', grep { !/^(?:foo|:all)$/ } keys %MICRO  ) # 'foo' is still first
      : @_;
    $Structure = $structures[0] if @structures;
    $micro = AI::MicroStructure->new( $Structure );
    # export the microname() function
    no strict 'refs';
    my $callpkg = caller;
    *{"$callpkg\::microname"} = \&microname;    # standard theme
    # load the classes in @structures
    for my $structure( @structures ) {
        eval "require AI::MicroStructure::$structure; import AI::MicroStructure::$structure;";
        croak $@ if $@;
        *{"$callpkg\::micro$structure"} = sub { $micro->name( $structure, @_ ) };
    }
}
sub new {
    my ( $class, @args ) = ( @_ );
    my $structure;
    $structure = shift @args if @args % 2;
    $structure = $Structure unless $structure; # same default everywhere
    # defer croaking until name() is actually called
    bless { structure => $structure, args => { @args }, micro => {} ,state=>$state}, $class;
}
sub _rearrange{
   my $self = shift;
   $self->{'payload'} = shift if @_;
   return %$self;
}
# CLASS METHODS
sub add_structure {
   my $class  = shift;
   my %structures = @_;
   for my $structure ( keys %structures ) {
   croak "The structure $structure already exists!" if exists $MICRO{$structure};
   my @badnames = grep { !/^[a-z_]\w*$/i } @{$structures{$structure}};
   croak "Invalid names (@badnames) for structure $structure"
   if @badnames;
   my $code = << "EOC";
package AI::MicroStructure::$structure;
use strict;
use AI::MicroStructure::List;
our \@ISA = qw( AI::MicroStructure::List );
our \@List = qw( @{$structures{$structure}} );
__PACKAGE__->init();
1;
EOC
   eval $code;
   $MICRO{$structure} = 1; # loaded
   # export the microstructure() function
   no strict 'refs';
   my $callpkg = caller;
   *{"$callpkg\::micro$structure"} = sub { $micro->name( $structure, @_ ) };
   }
}
# load the content of __DATA__ into a structure
# this class method is used by the other AI::MicroStructure classes
sub load_data {
   my ($class, $structure ) = @_;
   $data = {};
   my $fh;
   { no strict 'refs'; $fh = *{"$structure\::DATA"}{IO}; }
   my $item;
   my @items;
   $$item = "";
   {
   if(defined($fh)){
   local $_;
   while (<$fh>) {
   /^#\s*(\w+.*)$/ && do {
   push @items, $item;
   $item = $data;
   my $last;
   my @keys = split m!\s+|\s*/\s*!, $1;
   $last = $item, $item = $item->{$_} ||= {} for @keys;
   $item = \( $last->{ $keys[-1] } = "" );
   next;
   };
   $$item .= $_;
   }
   }
}
   # clean up the items
   for( @items, $item ) {
   $$_ =~ s/\A\s*//;
   $$_ =~ s/\s*\z//;
   $$_ =~ s/\s+/ /g;
   }
   return $data;
}
#fitnes
sub fitnes {
    my $self = shift;
    return sha1_hex($self->structures());
   ##my ($config,$structure, $config ) = (shift,[$self->structures()]); FIXME
}
# main function
sub microname { $micro->name( @_ ) };
sub shitname {
    my $self = shift;
    my ( $structure, $count ) = ("any",1);
    if (@_) {
        ( $structure, $count ) = @_;
        ( $structure, $count ) = ( $self->{structure}, $structure )
          if $structure =~ /^(?:0|[1-9]\d*)$/;
    }
    else {
        ( $structure, $count ) = ( $self->{structure}, 1 );
    }
    if( ! exists $self->{micro}{$structure} ) {
        my ( $structure, $category ) = split /\//, $structure, 2;
        if( ! $MICRO{$structure}  ) {
            try{
#            `micro new $structure`;
            eval "require '$absstructdir/$structure.pm';";
            $MICRO{$structure} = 1; # loaded
            $self->{micro}{$structure}  = AI::MicroStructure->new($structure,category => $category);
            print $self->{micro}{$structure}->name( $count );
            return;
            }  catch{
            }
        }
    }
}
# corresponding method
sub name {
   my $self = shift;
   my ( $structure, $count ) = ("any",1);
   if (@_) {
   ( $structure, $count ) = @_;
   ( $structure, $count ) = ( $self->{structure}, $structure )
   if defined($structure) && $structure =~ /^(?:0|[1-9]\d*)$/;
   }
   else {
   ( $structure, $count ) = ( $self->{structure}, 1 );
   }
   if( ! exists $self->{micro}{$structure} ) {
   if( ! $MICRO{$structure} ) {
   eval "require '$absstructdir/$structure.pm';";
   croak "MicroStructure list $structure does not exist!" if $@;
   $MICRO{$structure} = 1; # loaded
   }
   $self->{micro}{$structure} =
   "AI::MicroStructure::$structure"->new( %{ $self->{args} } );
   }
   $self->{micro}{$structure}->name( $count );
}
# corresponding method
sub namex {
   my $self = shift;
   my ( $structure, $count ) = ("any",1);
   if (@_) {
   ( $structure, $count ) = @_;
   ( $structure, $count ) = ( $self->{structure}, $structure )
   if defined($structure) && $structure =~ /^(?:0|[1-9]\d*)$/;
   }
   else {
   ( $structure, $count ) = ( $self->{structure}, 1 );
   }
   if( ! exists $self->{micro}{$structure} ) {
   if( ! $MICRO{$structure} ) {
    try {
   eval "require '$absstructdir/$structure.pm';";
   $MICRO{$structure} = 1; # loaded
   croak "MicroStructure list $structure does not exist!" if $@;
    }catch{
      }
   }
   $self->{micro}{$structure} =
   "AI::MicroStructure::$structure"->new( %{ $self->{args} } );
   }
   $self->{micro}{$structure}->name( $count );
}
# other methods
sub structures { wantarray ? ( sort keys %MICRO ) : scalar keys %MICRO }
sub has_structure { $_[1] ? exists $MICRO{$_[1]} : 0 }
sub configure_driver { $_[1] ? exists $MICRO{$_[1]} : 0 }
sub count {
   my $self = shift;
   my ( $structure, $count );
   if (@_) {
   ( $structure, $count ) = @_;
   ( $structure, $count ) = ( $self->{structure}, $structure )
   if $structure =~ /^(?:0|[1-9]\d*)$/;
   }
   if( ! exists $self->{micro}{$structure} ) {
   return scalar ($self->{micro}{$structure}->new);
   }
   return 0;
}
sub trim
{
   my $self = shift;
   my $string = shift;
   $string =  "" unless  $string;
   $string =~ s/^\s+//;
   $string =~ s/\s+$//;
   $string =~ s/\t//;
   $string =~ s/^\s//;
   return $string;
}
sub getBundle {
   my $self = shift;
my @structures = grep { !/^(?:any)/ } AI::MicroStructure->structures;
my @micros;
my @search=[];
for my $structure (@structures) {
   no strict 'refs';
   eval "require '$absstructdir/$structure.pm';";
   my %isa = map { $_ => 1 } @{"AI::MicroStructure::$structure\::ISA"};
   if( exists $isa{'AI::MicroStructure::Locale'} ) {
   for my $lang ( "AI::MicroStructure::$structure"->languages() ) {
   push @micros,
   ["AI::MicroStructure::$structure"->new( lang => $lang ),$lang];
   }
   }
   elsif( exists $isa{'AI::MicroStructure::MultiList'} ) {
   for my $cat ( "AI::MicroStructure::$structure"->categories(), ':all' ) {
   push @micros,
   [ "AI::MicroStructure::$structure"->new( category => $cat ),$cat];
   }
   }
   else {
   push @micros, ["AI::MicroStructure::$structure"->new(),''];
   }
}
my  $all ={};
for my $test (@micros) {
   my $micro = $test->[0];
   my %items;
   my $items = $micro->name(0);
   $items{$_}++ for $micro->name(0);
   my $key=sprintf("%s",$micro->structure);
   $all->{$key}=[$test->[1],$micro->name($items)];
}
 return $all;
}
sub save_cat {
  my $self = shift;
  my $data = shift;
  my $dat;
  my $ret = "";
  foreach my $key(sort keys %{$data} ) {
   next unless($_);
   #ref $hash->{$_} eq "HASH"
   if(ref $data->{$key} eq "HASH"){
   $ret .= "\n".$self->save_cat($data->{$key});
   }else{
   $dat = $data->{$key};
   $dat =~ s/^|,/\n/g;
   $dat =~ s/\n\n/\n/g;
   $dat =~ s/->\n|[0-9]\n//g;
   $ret .= "# ".($key=~/names|default|[a-z]/?$key:"names ".$key);
   $ret .= "\n ".$dat."\n";
   }
  }
  return $ret;
}
sub save_default {
  my $self = shift;
  my $data = shift;
  my $line = shift;
  my $dat = {};
  my @in = ();
  my $active=0;
  $line = $Structure unless($line);
  foreach(@{$data->{rows}->{"coordinate"}}){
   if($_ eq $line){ $active=1; }
   if(1+$line eq $_){ $active=0; }