# Copyright 2008, 2009, 2010, 2011 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart::SymbolMatch;
use strict;
use warnings;
use App::Chart;
use App::Chart::Gtk2::Symlist;


sub find {
  my ($target, $preferred_symlist) = @_;
  if ($target eq '') { return; }
  my @symlists = App::Chart::Gtk2::Symlist->all_lists;

  # elevate $preferred_symlist to first in @symlists
  if ($preferred_symlist) {
    @symlists = grep {$_ != $preferred_symlist} @symlists;
    splice @symlists, 0,0, $preferred_symlist;
  }

  # exclude subset lists like "Alerts"
  # @symlists = grep {! $_->is_subset} @symlists;

  foreach my $proc (\&eq, \&eq_ci,
                    \&eq_sans_suffix, \&eq_ci_sans_suffix,
                    \&eq_ci_sans_hat,
                    \&prefix_ci_sans_hat) {
    foreach my $symlist (@symlists) {
      my $listref = $symlist->symbol_listref;
      foreach my $symbol (@$listref) {
        if ($proc->($target, $symbol)) {
          return ($symbol, $symlist);
        }
      }
    }
  }
  return undef;
}

sub eq {
  my ($x, $y) = @_;
  return $x eq $y;
}
sub eq_ci {
  my ($x, $y) = @_;
  return uc($x) eq uc($y);
}
sub eq_sans_suffix {
  my ($x, $y) = @_;
  $x = App::Chart::symbol_sans_suffix ($x);
  $y = App::Chart::symbol_sans_suffix ($y);
  return $x eq $y;
}
sub eq_ci_sans_suffix {
  my ($x, $y) = @_;
  $x = App::Chart::symbol_sans_suffix ($x);
  $y = App::Chart::symbol_sans_suffix ($y);
  return uc($x) eq uc($y);
}
sub eq_ci_sans_hat {
  my ($x, $y) = @_;
  $x =~ s/^\^//;
  $y =~ s/^\^//;
  return uc($x) eq uc($y);
}
sub prefix_ci_sans_hat {
  my ($part, $str) = @_;
  $part =~ s/^\^//;
  $str  =~ s/^\^//;
  return ($str =~ /^\U\Q$part/);
}

1;
__END__

=for stopwords symlist bh BHP gsp

=head1 NAME

App::Chart::SymbolMatch -- loose matching of symbols

=head1 SYNOPSIS

 use App::Chart::SymbolMatch;

=head1 DESCRIPTION

This module is used for loose symbol entry on the command line and in the
Open dialog (see L<App::Chart::Gtk2::OpenDialog>).  It's only a separate
module to keep a tricky bit of code away from other things.

=head1 FUNCTIONS

=over 4

=item C<< ($symbol, $symlist) = App::Chart::SymbolMatch::find ($target) >>

=item C<< ($symbol, $symlist) = App::Chart::SymbolMatch::find ($target, $preferred_symlist) >>

Find a symbol for the partial string C<$target> in the symlists and return
the symbol and symlist, or return no values if nothing matches (which
include when C<$target> is the empty string C<"">).

Progressively looser matches are attempted.  So first an exact match in the
given C<$preferred_symlist>, otherwise other lists.  Otherwise a
case-insensitive match, or a match without suffix (but always following an
explicit suffix on C<$target>), or a partial match at the start of the
symbol, and possibly without the index "^" marker.

The effect is that for instance a C<$target> "bh" might match "BHP.AX", or
"gsp" might match "^GSPC".  Note that an exact match anywhere is preferred
over a partial match in the current list, because otherwise you could type
an exact full symbol like "FOO" and still be left on a "FOO.AX" in the
current list.

=back

=head1 SEE ALSO

L<App::Chart>

=cut