package TM::Bulk;

use TM;
use Class::Trait 'base';

use Data::Dumper;

=pod

=head1 NAME

TM::Bulk - Topic Maps, Bulk Retrieval Trait

=head1 SYNOPSIS

  my $tm = .....                          # get a map from anywhere

  use TM::Bulk;
  use Class::Trait;
  Class::Trait->apply ($tm, 'TM::Bulk');  # give the map the trait

  # find out environment of topic
  my $vortex = $tm->vortex ('some-lid',
                           {
	  	 	    'types'       => [ 'types' ],
		 	    'instances'   => [ 'instances*', 0, 20 ],
			    'topic'       => [ 'topic' ],
			    'roles'       => [ 'roles',     0, 10 ],
			    'members'     => [ 'players' ],
			   },
			   );
  # find names of topics (optionally using a scope preference list)
  my $names = $tm->names ([ 'ccc', 'bbb', 'aaa' ], [ 's1', 's3', '*' ]);

=head1 DESCRIPTION

Especially when you build user interfaces, you might need access to a lot of topic-related
information. Instead of collecting this 'by foot' the following methods help you achieve this more
effectively.

=over

=item B<names>

I<$name_hash_ref> = I<$tm>->names (I<$lid_list_ref>, [ I<$scope_list_ref> ] )

This method takes a list (reference) of topic ids and an optional list of scoping topic ids.  For
the former it will try to find the I<name>s (I<topic names> for TMDM acolytes).

If the list of scopes is empty then the preference is on the unconstrained scope. If no name for a
topic is in that scope, any other will be used.

If the list of scopes is non-empty, it directs to look first for a name in the first scoping topic,
then second, and so on. If you want to have one name in any case, append C<*> to the scoping list.

If no name exist for a particular I<lid>, then an C<undef> is returned in the result hash.

The overall result is a hash (reference) having the lids as keys and the name strings as values.

=cut

sub scoped_names {
    my $self = shift;

#@@@@@
}

sub names {
    my $self   = shift;
    my $topics = shift || [];
    my $scopes = shift || [ '*' ];

#warn "looking for ".Dumper $topics;
    my $dontcare = 0;                                                  # one of the rare occasions I need a boolean
    if ($scopes->[-1] eq '*') {
	pop @$scopes;                                                  # get rid of this '*' to have a clean topic list
	$dontcare = 1;                                                 # remember this incident for below
    }
    my @scopes = grep { $_ } $self->mids (@$scopes);                   # make them absolute, so that we can compare later (only keep existing ones)
#warn "scopes".Dumper \@scopes;

    my ($US) = @{$self->{usual_suspects}}{'us'};
    my %dict;                                                          # this is what we are building
TOPICS:
    foreach my $lid (grep { $_ } $self->mids (@$topics)) {             # for all in my working list, make them absolute, and test
	next if $dict{$lid};                                           # do not things twice
	my @as = grep { $_->[TM->KIND] == TM->NAME }                   # filter all characteristics for basenames
	            $self->match_forall (char => 1, topic => $lid);
        next unless @as;                                               # assertion: @as contains at least one entry!
	unless (@scopes) {                                             # empty list? preference is unconstrained scope
	    if (my @aas = grep ($_->[TM->SCOPE] eq $US, @as)) {
		$dict{$lid} = $aas[0]->[TM->PLAYERS]->[1]->[0];
		next TOPICS;
	    }
	}
	foreach my $sco ($self->mids (@scopes)) {                      # check out all scope preferences (note, there is at least one in @as!)
	    if (my @aas = grep ($_->[TM->SCOPE] eq $sco, @as)) {
		$dict{$lid} = $aas[0]->[TM->PLAYERS]->[1]->[0];
		next TOPICS;
	    }
	}
	$dict{$lid} = $dontcare ? $as[0]->[TM->PLAYERS]->[1]->[0]      # get the name and derereference it
	                        : undef;                               # otherwise we have none
    }
    return \%dict;
}

=pod

=item B<vortex>

I<$info> = I<$tm>->vortex (,
               I<$vortex_lid>,
               I<$what_hashref>,
               I<$scope_list_ref> )

This method returns B<a lot> of information about a particular toplet (vortex). The function expects
the following parameters:

=over

=item I<lid>:

the lid of the toplet in question

=item I<what>:

a hash reference describing the extent of the information (see below)

=item I<scopes>:

a list (reference) to scopes (currently B<NOT> honored)

=back

To control B<what> exactly should be returned, the C<what> hash reference can contain following
components. All of them being tagged with <n,m> accept an additional pair of integer specify the
range which should be returned.  To ask for the first twenty, use C<0,19>, for the next
C<20,39>. The order in which the identifiers is returned is undefined but stable over subsequent
read-only calls.

=over

=item I<topic>:

fetches the midlet (which is only the subject locator, subject indicators information).

=item I<names> (<n,m>):

fetches all names (as array reference triple [ I<type>, I<scope>, string value ])

=item I<occurrences> (<n,m>):

fetches all occurrences (as array reference triple [ I<type>, I<scope>, I<value> ])

=item I<instances> (<n,m>):

fetches all midlets which are direct instances of the vortex (that is regarded as
class here);

=item I<instances*> (<n,m>):

same as C<instances>, but including all instances of subclasses of the vortex

=item I<types> (<n,m>):

fetches all (direct) types of the vortex (that is regarded as instance here)

=item I<types*> (<n,m>):

fetches all (direct and indirect) types of the vortex (that is regarded as instance here)

=item I<subclasses>  (<n,m>):

fetches all direct subclasses

=item I<subclasses*> (<n,m>):

same as C<subclasses>, but creates reflexive, transitive closure

=item I<superclasses> (<n,m>):

fetches all direct superclasses

=item I<superclasses*> (<n,m>):

same as C<superclasses>, but creates reflexive, transitive closure

=item I<roles> (<n,m>):

fetches all assertion ids where the vortex B<is> plays a role

=back

The function will determine all of the requested information and will prepare a hash reference
storing each information into a hash component. Under which name this information is stored, the
caller can determine with the hash above as the example shows:

Example:

  $vortex = $tm->vortex ('some-lid',
                         {
			  'types'       => [ 'types' ],
			  'instances'   => [ 'instances*', 0, 20 ],
			  'topic'       => [ 'topic' ],
			  'roles'       => [ 'roles',     0, 10 ],
			 },
			);

The method dies if C<lid> does not identify a proper midlet.

=cut

sub vortex {
  my $self   = shift;
  my $lid    = shift;
  my $what   = shift;
  my $scopes = shift             and $TM::log->logdie ("scopes not supported yet");

  my $alid   = $self->mids ($lid) or $TM::log->logdie ("no topic '$lid'");

  my ($ISSC, $ISA) = @{$self->{usual_suspects}}{'is-subclass-of', 'isa'};
  
  my @as = $self->match_forall (iplayer => $alid);            # find out everything we know about the player

  my $_t;                                                     # here all the goodies go
  foreach my $where (keys %{$what}) {                         # collect here what the user wants
      my $w = shift @{$what->{$where}};

      if ($w eq 'topic') {
	  $_t->{$where} = $self->midlet ($alid);
	  
      } else {
	  my @is;
	  if (grep ($w =~ /^$_\*?$/, qw(instances types subclasses superclasses))) {
	      $w =~ s/\*/T/;

	      @is  = $self->$w ($alid); # whoa, Perl late binding rocks !
	  
	  } elsif ($w eq 'names') {
	      @is = map { [ $_->[TM->TYPE], $_->[TM->SCOPE], $_->[TM->PLAYERS]->[1]->[0] ] }
	            grep { $_->[TM->KIND] == TM->NAME }
                    @as;
	  
	  } elsif ($w eq 'occurrences') {
	      @is = map { [ $_->[TM->TYPE], $_->[TM->SCOPE], $_->[TM->PLAYERS]->[1] ] }
	            grep { $_->[TM->KIND] == TM->OCC }
	            @as;
	  
	  } elsif ($w eq 'roles') {
	      @is = map { $_->[ TM->LID ] }
                    grep { $_->[TM->TYPE] ne $ISSC && $_->[TM->TYPE] ne $ISA }
	            grep { $_->[TM->KIND] == TM->ASSOC }
                    @as;
	  }
	  my ($from, $to) = _calc_limits (scalar @is, shift @{$what->{$where}}, shift @{$what->{$where}});
	  $_t->{$where} = [ @is[ $from .. $to ] ];
      }
  }
  return $_t;                                                                   # and ship it all back

  sub _calc_limits {
      my $last  = (shift) - 1; # last available
      my $from  = shift || 0;
      my $want  = shift || 10;
      my $to = $from + $want - 1;
      $to = $last if $to > $last;
      return ($from, $to);
  }
}

=pod

=back

=head1 SEE ALSO

L<TM::Overview>

=head1 COPYRIGHT AND LICENSE

Copyright 200[3-57] by Robert Barta, E<lt>drrho@cpan.orgE<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

our $VERSION  = 0.4;
our $REVISION = '$Id: Bulk.pm,v 1.2 2007/07/17 16:23:05 rho Exp $';

1;

__END__