The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright 2009, 2011 Kevin Ryde.

# MyStuff.pm is shared by various distributions.
#
# MyStuff.pm 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.
#
# MyStuff.pm 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 this file.  If not, see <http://www.gnu.org/licenses/>.

package MyStuff;
use 5.010;
use strict;
use warnings;
use Text::Tabs;

#my $verbose = 0;

sub line_at_pos {
  my ($str, $pos) = @_;
  my $start = (rindex ($str, "\n", $pos) || -1) + 1;
  my $end = (index ($str, "\n", $pos) || length($str)-1) + 1;
  return substr($str, $start, $end - $start);
}

sub pos_to_line_and_column {
  my ($str, $pos) = @_;
  $str = substr ($str, 0, $pos);
  my $nlpos = rindex ($str, "\n");
  my $lastline = substr ($str, $nlpos+1);
  $lastline = Text::Tabs::expand ($lastline);
  my $colnum = 1 + length ($lastline);
  my $linenum = 1 + scalar($str =~ tr/\n//);
  return ($linenum, $colnum);
}



package Iterator::Simple::FileUniq;
sub new {
  my ($class, $it) = (shift, shift);
  my $fu = FileUniq->new (@_);
  return Iterator::Simple::iterator
    (sub {
       my $filename;
       while (defined (my $filename = $it->next)) {
         last if $fu->uniq ($filename);
       }
     });
}

package Locator;
sub new {
  my ($class, @args) = @_;
  open my $fh, '-|', 'locate', '-0', '--', @args or die;
  return bless { fh => $fh,
               }, $class;
}
sub next {
  my ($self) = @_;
  my $fh = $self->{'fh'};
  my $filename;
  {
    local $/ = "\0";
    $filename = <$fh>;
    if (defined $filename) {
      chomp $filename;
    }
  }
  return $filename;
}

package Locator::BinScripts;
sub new {
  my ($class, $type) = @_;
  return bless { 'type' => $type,
                 'locator' => Locator->new ('/bin/*',
                                            '/usr/bin/*',
                                            '/usr/local/bin/*',
                                            '/usr/local/bin2/*',
                                           ) }, $class;
}
sub next {
  my ($self) = @_;
  my $type = $self->{'type'};
  for (;;) {
    my $filename = $self->{'locator'}->next // return undef;
    my ($fh, $buf);
    if (open($fh,'<',$filename)
        && read($fh,$buf,80)
        && $buf =~ m{^#![a-z0-9/]*/$type([ \t]|$)}) {
      return $filename;
    }
  }
}

package Locator::Concat;
sub new {
  my ($class, @locators) = @_;
  return bless { 'locators' => \@locators }, $class;
}
sub next {
  my ($self) = @_;
  my $locators = $self->{'locators'};
  for (;;) {
    @$locators or return undef;
    my $filename = $locators->[0]->next;
    if (defined $filename) { return $filename; }
    shift @$locators;
  }
}

1;
__END__
my @files = split /\n/, `locate \*.t \*.pm \*.pl`;
@files = grep {-f $_} @files;

@files = uniq_by_func (\&stat_dev_ino, @files);
sub uniq_by_func {
  my $func = shift;
  my %seen;
  return grep { $seen{$func->($_)}++ == 0 } @_;
}
sub stat_dev_ino {
  my ($filename) = @_;
  my ($dev, $ino) = stat ($filename);
  return "$dev,$ino";
}

print "look at ",scalar(@files)," files\n";