package FreeBSD::Ports::Port;

use strict;
use vars qw($VERSION);
use Carp qw(carp);

$VERSION	= '0.04';


sub new {
    my($class, $port_line, $handle) = @_;

    carp 'Port name not specified' unless defined $port_line;
    # If we don't have a line from an INDEX to process, read from the handle
    # instead.  INDEX lines always contain a '|' character, whereas port names
    # never should.
    unless ($port_line =~ m!\|!) {
	carp 'No handle specified' unless defined $handle;
	$handle->seek( 0, 0 ) or carp 'Cannot seek on the handle you specified';

	my $port_name = $port_line;
	my $name_length = length $port_name;
	# Read from the handle until we find a port starting with the
	# desired string.
	do {
	    $port_line = $handle->getline() or carp "The port '$port_name' does not exist";
	} until substr( $port_line, 0, $name_length ) eq $port_name;
    }

    chomp $port_line;
    # Fields are '|' delimited in INDEX lines
    my @port_info = split( m!\|!, $port_line );

    my $port = bless {
	'DISTRIBUTION_NAME'	=> shift @port_info,
	'PORT_PATH'		=> shift @port_info,
	'INSTALLATION_PREFIX'	=> shift @port_info,
	'COMMENT'		=> shift @port_info,
	'DESCRIPTION_FILE'	=> shift @port_info,
	'MAINTAINER'		=> shift @port_info,
	'CATEGORIES'		=> {},
	'BUILD_DEPS'		=> {},
	'RUN_DEPS'		=> {}
    }, $class;

    my @categories			= split( m! !, shift(@port_info) );
    $port->{'PRIMARY_CATEGORY'}		= shift @categories;
    foreach (@categories) {
    	$port->{'CATEGORIES'}{$_}	= undef;
    }

    return $port unless @port_info;	# return if no more fields exist
    foreach (split( m! !, shift(@port_info) )) {
	$port->{'BUILD_DEPS'}{$_}	= undef;
    }

    return $port unless @port_info;	# return if no more fields exist
    foreach (split( m! !, shift(@port_info) )) {
	$port->{'RUN_DEPS'}{$_}		= undef;
    }

    return $port unless @port_info;	# return if no more fields exist
    $port->{'WWW'} = shift @port_info;

    return $port;
}

sub as_ascii {
    my($self, $base_category) = @_;
    my $text = "$self->{'DISTRIBUTION_NAME'}
	$self->{'COMMENT'}
	Maintained by: $self->{'MAINTAINER'}
";
    my $requires_text = join(', ', $self->all_depends());
    $text .= "\tRequires: $requires_text\n" if $requires_text;
    if ($base_category) {
	my $cat_text = join(', ', $self->all_categories($base_category));
	$text .= "\tAlso listed in: $cat_text\n" if $cat_text;
    } else {
	my $cat_text = join(', ', $self->all_categories());
	$text .= "\tCategories: $cat_text\n" if $cat_text;
    }
    $text .= "\tWWW: $self->{'WWW'}\n" if exists $self->{'WWW'};
    return $text;
}

sub name {		shift->_elem('DISTRIBUTION_NAME',	@_) }
sub path {		shift->_elem('PORT_PATH',		@_) }
sub prefix {		shift->_elem('INSTALLATION_PREFIX',	@_) }
sub comment {		shift->_elem('COMMENT',			@_) }
sub descr_file {	shift->_elem('DESCRIPTION_FILE',	@_) }
sub maintainer {	shift->_elem('MAINTAINER',		@_) }
sub www {		shift->_elem('WWW',			@_) }
sub primary_category {	shift->_elem('PRIMARY_CATEGORY',	@_) }

sub categories {
    my $cats = shift->_elem('CATEGORIES', @_);
    return wantarray ? sort keys %$cats : $cats;
}

sub build_depends {
    my $deps = shift->_elem('BUILD_DEPS', @_);
    return wantarray ? sort keys %$deps : $deps;
}

sub run_depends {
    my $deps = shift->_elem('RUN_DEPS', @_);
    return wantarray ? sort keys %$deps : $deps;
}

sub all_depends {
    my $self = shift;
    return $self->{'ALL_DEPS'} if exists $self->{'ALL_DEPS'};
    my $build_ref = $self->{'BUILD_DEPS'};
    my $run_ref = $self->{'RUN_DEPS'};
    my %all_deps = (%$build_ref, %$run_ref);
    $self->{'ALL_DEPS'} = \%all_deps;
    return wantarray ? sort keys %all_deps : \%all_deps;
}

sub all_categories {
    my ($self, $base_category) = @_;
    my %category;
    foreach ($self->{'PRIMARY_CATEGORY'}, keys %{ $self->{'CATEGORIES'} }) {
	unless (defined $base_category and $_ eq $base_category) {
	    $category{$_} = undef;
	}
    }
    return wantarray ? sort keys %category : \%category;
}

sub _elem {
    my($self, $elem, $val) = @_;
    my $old = $self->{$elem};
    $self->{$elem} = $val if defined $val;
    return $old;
}

1;

__END__


=head1 NAME

FreeBSD::Ports::Port - Deal with individual ports from FreeBSD's ports collection

=head1 WARNING!

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

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

=head1 SYNOPSIS

  # Who maintains the 'arc-5.21e' port?
  # NOTE: Normally the FreeBSD::Ports module is used to do this.
  use FreeBSD::Ports::Port;
  use IO::File;
  my $index = IO::File->new('/usr/ports/INDEX', 'r') or die;
  my $port = FreeBSD::Ports::Port->new('arc-5.21e', $index);
  print $port->maintainer,"\n";



=head1 DESCRIPTION

C<FreeBSD::Ports::Port> is a simple interface for parsing lines in
FreeBSD's ports INDEX file.

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 $port = FreeBSD::Ports::Port->new($port_proto, $handle)

Constructor method to create a new FreeBSD::Ports::Port object. This
method is usually called within L<FreeBSD::Ports|FreeBSD::Ports>.  Most
programmers will rarely need to call this method.

C<$port_proto> may either be the name of a port, or a complete line from
an INDEX file.  If the name of a port is given, then C<$handle> should
be a seekable handle for an INDEX.  Such a handle is typically created
using L<IO::File|IO::File>.

C<$port> is an object representing the specified port.

=item $text = $port->as_ascii

Describe the port in ASCII text format.  C<$text> contains a description
of the port.

=item $name = $port->name

C<$name> is the name of the port.

=item $path = $port->path

C<$path> is the location on a FreeBSD filesystem where this port is
found.

=item $prefix = $port->prefix

C<$prefix> is the area of the filesystem where this port is installed,
usually F</usr/local> or F</usr/X11R6>.

=item $comment = $port->comment

C<$comment> is a brief comment describing the port.

=item $descr_file = $port->descr_file

C<$descr_file> is the name of a file which contains a longer description
of the port.

=item $maintainer = $port->maintainer

C<$maintainer> is the e-mail address of the person who maintains the
port.

=item $www_url = $port->www

C<$www_url> is the URL of a resource containing further information
about the software included in the port.

=item $primary_category = $port->primary_category

C<$primary_category> is the name of the primary category for the port.
A 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.

=item @categories = $port->categories  OR  $categories = $port->categories

Returns a list of categories which the port is in, I<excluding> its primary
category.

If called in array context, C<@categories> is sorted alphabetically and
case insensitively.  In scalar context, C<$categories> is a reference to
a hash.  The keys of the hash are names of categories.  No importance
should be attached to the values of the hash.

=item @categories = $port->all_categories  OR  $categories = $port->all_categories

Returns a list of categories which the port is in, including its primary
category.

If called in array context,  C<@categories> is sorted alphabetically and
case insensitively.  In scalar context, C<$categories> is a reference to
a hash, in the same style as the C<categories> method.

=item @depends = $port->build_depends  OR  $depends = $port->build_depends

Returns a list of other ports which are required to build the port.

If called in array context, C<@depends> is sorted alphabetically and
case insensitively.  In scalar context, C<$depends> is a reference to a
hash, in the same style as the C<categories> method.

=item @depends = $port->run_depends  OR  $depends = $port->run_depends

Returns a list of other ports which are required to run the port.

If called in arrary context, C<@depends> is sorted alphabetically and
case insensitively.  In scalar context, C<$depends> is a reference to a
hash, in the same style as the C<categories> method.

=item @depends = $port->all_depends  OR  $depends = $port->all_depends

Returns a list of other ports which are required by the port in any way.
At present, this means other ports which are required to build or run
the port.

If called in arrary context, C<@depends> is sorted alphabetically and
case insensitively.  In scalar context, C<$depends> is a reference to a
hash, in the same style as the C<categories> method.

=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
