view release on metacpan or  search on metacpan

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

   }
   $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; }
   if($active==1){
   $_=~s/,//g;
   $_ = $self->trim($_);
   $dat->{names}->{$_}=$_ unless(defined($dat->{names}->{$_}));
   }
}
foreach(@{$data->{rows}->{"search"}}){
   if($_ eq $line){  $active=1; }
   if(1+$line eq $_){ $active=0; }
   if($active==1){
   $_=~s/,//g;
   $_ = $self->trim($_);
   $dat->{names}->{$_}=$_ unless(defined($dat->{names}->{$_}));
   }
}
push @in , keys %{$dat->{names}};
push @in , values %{$data->{names}};
$dat->{names} = join(" ",@in);
$dat->{names} =~ s/$line(.*?)\-\>(.*?) [1-9] /$1 $2/g;
$dat->{names} =~ s/  / /g;
my @file = grep{/$Structure/}map{File::Glob::bsd_glob(
 File::Spec->catfile( $_, ($structdir,"*.pm") ) )}@CWD;
  if(@file){
  open(SELF,"+<$file[0]") || die $!;
  while(<SELF>){last if /^__DATA__/}