package FreeBSD::Ports;

use strict;
use vars qw($VERSION $Index_File);

use Carp qw(carp);
use IO::File qw(O_RDONLY);
use FreeBSD::Ports::Port ();

$VERSION	= '0.04';
$Index_File	= '/usr/ports/INDEX';


sub TIEHASH {
    my $class = shift;
    my $ports;

    if (ref $class) {
	$ports = $class->_clone();
    } else {
	$ports = bless { }, $class;
	my $filename = (shift or $Index_File);

	my $index = IO::File->new( $filename, O_RDONLY )
	    or carp "Cannot read file $filename";
	# Create a FreeBSD::Ports::Port object for each INDEX line
	while (my $index_line = $index->getline()) {
	    my $port = FreeBSD::Ports::Port->new($index_line);
	    my $port_name = $port->{'DISTRIBUTION_NAME'};
	    $ports->{'PORTS'}{$port_name} = $port;
	}
    }
    return $ports;
}

sub FETCH {
    my($self, $port_name) = @_;
    return $self->{'PORTS'}{$port_name};
}

sub STORE { carp 'Method STORE not implemented' }
sub DELETE { carp 'Method DELETE not implemented' }
sub CLEAR { carp 'Method CLEAR not implemented' }

sub EXISTS {
    my($self, $port_name) = @_;
    return exists $self->{'PORTS'}{$port_name};
}

sub FIRSTKEY {
    my $self = shift;
    # If the ports are sorted use the SORTED array, else use the PORTS hash
    unless (exists $self->{'SORTED'}) {
	keys %{ $self->{'PORTS'} };		# reset each() iterator
	return each %{ $self->{'PORTS'} };
    }
    $self->{'KEY_OFFSET'} = 0;
    return $self->{'SORTED'}[0];
}

sub NEXTKEY {
    my $self = shift;
    # If the ports are sorted use the SORTED array, else use the PORTS hash
    return (each %{ $self->{'PORTS'} }) unless exists $self->{'SORTED'};
    my $offset = ++($self->{'KEY_OFFSET'});
    return $self->{'SORTED'}[$offset];
}

sub _clone {
    my $self = shift;
    my $clone = bless {
	'PORTS'		=> { %{$self->{'PORTS'}} }, # copy the ports entries
    }, ref $self;
    $clone->{'SORTED'} = [ @{$self->{'SORTED'}} ] if exists $self->{'SORTED'};
    foreach (qw(SORTED_BY SORT_FIELD)) {
	$clone->{$_} = $self->{$_} if exists $self->{$_};
    }
    return $clone;
}

sub maintainer {
    my($self, $email) = @_;
    return $self->_select_string( $email, 'maintainer', 1 );
}

sub primary_category {
    my($self, $category_name) = @_;
    return $self->_select_string( $category_name, 'primary_category' );
}

# Only select those ports where a given property (e.g. 'primary_category')
# in $property matches a given value in $value.  Do so case insensitively
# if $insensitive is 1.
sub _select_string {
    my($self, $match, $property, $insensitive) = @_;
    $match = lc($match) if $insensitive == 1;
    my $ports_ref = $self->{'PORTS'};

    while (my($port_name, $port) = each %$ports_ref) {
	my $value = $port->$property();
	$value = lc($value) if $insensitive == 1;
	delete $ports_ref->{$port_name} if $value ne $match;
    }
    $self->sort() if (exists $self->{'SORTED'});

    return $self;
}

sub category {
    my($self, $category_name) = @_;
    my $ports_ref = $self->{'PORTS'};
    while (my($port_name, $port) = each %$ports_ref) {
	my $categ_ref = $port->all_categories();
	unless (exists $categ_ref->{$category_name}) {
	    delete $ports_ref->{$port_name};
	}
    }
    $self->sort() if (exists $self->{'SORTED'});

    return $self;
}

sub run_depends {
    my($self, $port) = @_;
    return $self->_depends( $port, 'run_depends' );
}

sub build_depends {
    my($self, $port) = @_;
    return $self->_depends( $port, 'build_depends' );
}

sub depends {
    my($self, $port) = @_;
    return $self->_depends( $port, 'all_depends' );
}

sub _depends {
    my($self, $depends_proto, $depends_type) = @_;
    # $depends_proto contains either a FreeBSD::Ports::Port object or the
    # name of a port
    my $depends_name = ref $depends_proto ?
	$depends_proto->name() :
	$depends_proto;

    my $ports_ref = $self->{'PORTS'};
    while (my($port_name, $port) = each %$ports_ref) {
	my $depends_ref = $port->$depends_type();
	unless (exists $depends_ref->{$depends_name}) {
	    delete $ports_ref->{$port_name};
	}
    }
    $self->sort() if (exists $self->{'SORTED'});

    return $self;
}

sub sort {
    my($self, $method, $field) = @_;
    $method ||= $self->{'SORTED_BY'} if exists($self->{'SORTED_BY'});
    carp 'Sorting method not defined' unless defined $method;
    $field ||= $self->{'SORT_FIELD'} if exists($self->{'SORT_FIELD'});
    $field ||= 'DISTRIBUTION_NAME';

    my @sorted;
    my $ports_ref = $self->{'PORTS'};
    if ($method eq 'alpha') {
	@sorted = sort {
	    $ports_ref->{$a}{$field} cmp $ports_ref->{$b}{$field}
	} keys %$ports_ref;
    } elsif ($method eq 'rev_alpha') {
	@sorted = sort {
	    $ports_ref->{$b}{$field} cmp $ports_ref->{$a}{$field}
	} keys %$ports_ref;
    } else {
        carp "Invalid sorting method: $method";
    }

    $self->{'SORTED'} = \@sorted;   # sorted FreeBSD::Ports::Port objects
    $self->{'SORTED_BY'} = $method; # sorted alphabetically or reverse?
    $self->{'SORT_FIELD'} = $field; # the field sorted on

    return $self;
}

sub match {
    my($self, $term, $field, $insensitive) = @_;
    carp 'Search term not defined' unless defined $term;
    $field = 'COMMENT' unless defined $field;

    # Prepare a matching subroutine for use below
    #   $_[0]: $port (FreeBSD::Port object)
    #   $_[1]: $term (match term)
    #   $_[2]: $field (INDEX field to match on, e.g. COMMENT)
    my $match_sub = (defined $insensitive && $insensitive == 1) ?
	sub { $_[0]->{$_[2]} =~ m!$_[1]!i } :
	sub { $_[0]->{$_[2]} =~ m!$_[1]! };

    my $ports_ref = $self->{'PORTS'};
    # Remove non-matching ports from the collection
    while (my($port_name, $port) = each %$ports_ref) {
	unless ( &$match_sub($port, $term, $field) ) {
	    delete $ports_ref->{$port_name};
	}
    }
    $self->sort() if (exists $self->{'SORTED'});

    return $self;
}

1;

__END__


=head1 NAME

FreeBSD::Ports - Class for parsing FreeBSD's Ports INDEX

=head1 WARNING!

This is a very early version of this module.  The interface to the class
may be changed in the future.  The documentation needs improving.

Consequently, suggestions, comments and patches are extremely welcome!
I believe the correct place to discuss this module is the freebsd-doc
mailing list at freebsd-doc@freebsd.org.

=head1 SYNOPSIS

  # Describe ports maintained by tom@FreeBSD.org, sorted alphabetically
  use FreeBSD::Ports;
  my $ports = tie my %port, 'FreeBSD::Ports', '/usr/ports/INDEX';
  $ports->maintainer('tom@FreeBSD.org');
  $ports->sort('alpha');
  foreach my $p (values %port) {
      print $p->as_ascii,"\n";
  }

  # How many ports are there currently?
  use FreeBSD::Ports;
  my $ports = tie my %port, 'FreeBSD::Ports', '/usr/ports/INDEX';
  my $count = scalar keys %port;
  print "There are $count ports\n";

  # List ports containing 'MPEG' in their comment and present in the
  # 'audio' category?
  use FreeBSD::Ports;
  my $ports = tie my %port, 'FreeBSD::Ports', '/usr/ports/INDEX';
  $ports->category('audio');
  $ports->match('mpeg', 'COMMENT', 1);
  foreach my $name (keys %port) {
      print "$name\n";
  }

  # Any ports which are under the 'www' or 'net' category
  use FreeBSD::Ports;
  my $all_ports = tie my %port, 'FreeBSD::Ports';
  my $www_ports = tie my(%www_port), $all_ports;
  $www_ports->category('www');
  my $net_ports = tie my(%net_port), $all_ports;
  $net_ports->category('net');
  my %www_or_net_port;
  while ( my($key, $value) = (each(%www_port), each(%net_port)) ) {
      $www_or_net_port{$key} = $value;
  }


=head1 DESCRIPTION

C<FreeBSD::Ports> is a simple interface to the INDEX file used in
FreeBSD's ports collection.

This class uses Perl's I<tie> interface.  See L<perltie> for more
information.

For further information, or to obtain the latest version of this module,
see <URL:http://people.FreeBSD.org/~tom/portpm/>.

=head1 METHODS

=over 4

=item $ports = tie my %port, $class, $filename

Read and parse an INDEX file.  C<$filename> is the name of the file
containing the index.  If undefined, F</usr/ports/INDEX> is used.

C<$class> should be the name of the class (C<FreeBSD::Ports>) or another
C<FreeBSD::Ports> object to be cloned.

C<%port> is a hash whose keys are the names of the ports within the
index.  The value of each key is a
L<FreeBSD::Ports::Port|FreeBSD::Ports::Port> object.

C<$ports> is an object which can be accessed using the methods within
this class.

=item $ports->maintainer($email)

Selects only those ports whose maintainer's e-mail address is C<$email>.
Addresses are matched case insensitively.

=item $ports->primary_category($category_name)

Selects only those ports whose primary category is C<$category_name>.
The primary category is the first category in which a port is listed.
This represents the directory under F</usr/ports> in which a port is
stored.  Category names are matched case insensitively.

=item $ports->category($category_name)

Selects only those ports which are present in the category named
C<$category_name>.  In this case, category names are matched case
sensitively.

=item $ports->run_depends($port)

Selects only those ports which have a run dependency on the port
represented by C<$port>.

C<$port> is either the name of a port or a
L<FreeBSD::Ports::Port|FreeBSD::Ports::Port> object.

=item $ports->build_depends($port)

Selects only those ports which have a build dependency on C<$port>.

=item $ports->depends($port)

Selects those ports which have any type of dependency on C<$port>.

=item $ports->sort($method, $field)

Sorts the selected ports. C<$method> specifies how the ports should be
sorted.  I<alpha> means the ports should be sorted alphabetically, from
A to Z.  I<rev_alpha> means the ports should be sorted alphabetically in
reverse, from Z to A.  Sorting is performed case sensitively.

C<$field> specifies which property of the ports should be used to sort
by.  I<DISTRIBUTION_NAME> is used if this value is undefined.  One of
the following properties is usually selected:

=over 8

=item I<COMMENT>: Comment used to describe the port

=item I<DISTRIBUTION_NAME>: Port's name

=item I<MAINTAINER>: Maintainer's e-mail address

=item I<PRIMARY_CATEGORY>: Port's primary category

=back

=item $ports->match($term, $field, $insensitive)

Selects only those ports where C<$field> matches C<$term>.  The values
which can be used for C<$field> are the same as those used for the
C<sort> method.  However, for this method C<COMMENT> is used if
C<$field> is undefined.

C<$term> is evaluated as a regular expression.  If C<$insensitive> is
defined, the expression is evaluated case insensitively.  If undefined,
case sensitive evalutaion is used.

=head1 CREDITS

This module is written by Tom Hukins E<lt>tom@FreeBSD.orgE<gt>.

Thanks to Nik Clayton, Martin Heinen and Lars Thegler for encouragement,
assistance and patches.

=head1 COPYRIGHT

This module is distributed under the same license as FreeBSD
<http://www.FreeBSD.org/copyright/freebsd-license.html>.

=cut
