view release on metacpan or  search on metacpan

Table.pm  view on Meta::CPAN

use Error::Pure qw(err);
use Map::Tube::Text::Table::Utils qw(table);
use List::MoreUtils qw(any);
use Readonly;
use Scalar::Util qw(blessed);

# Constants.
Readonly::Scalar our $CONNECTED_TO => q{Connected to};
Readonly::Scalar our $ID => q{ID};
Readonly::Scalar our $JUNCTIONS => q{Junctions};
Readonly::Scalar our $LINE => q{Line};
Readonly::Scalar our $LINES => q{Lines};
Readonly::Scalar our $STATION => q{Station};

our $VERSION = 0.05;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Print ids.
	$self->{'print_id'} = 0;

	# Map::Tube object.
	$self->{'tube'} = undef;

	# Process params.
	set_params($self, @params);

	# Check Map::Tube object.
	if (! defined $self->{'tube'}) {
		err "Parameter 'tube' is required.";
	}
	if (! blessed($self->{'tube'})
		|| ! $self->{'tube'}->does('Map::Tube')) {

		err "Parameter 'tube' must be 'Map::Tube' object.";
	}

	# Object.
	return $self;
}

# Print junctions.
sub junctions {
	my $self = shift;

	# Get data.
	my @data;
	my @title = ($STATION, $LINE, $CONNECTED_TO);
	my @data_len = map { length $_ } @title;
	my $nodes_hr = $self->{'tube'}->nodes;
	foreach my $node_name (sort keys %{$nodes_hr}) {
		if (@{$nodes_hr->{$node_name}->line} > 1) {

			# Get data.
			my @links = map { $self->{'tube'}->get_node_by_id($_)->name }
				split m/,/ms, $nodes_hr->{$node_name}->link;
			my $data_ar = [
				$nodes_hr->{$node_name}->name,
				(join ', ', map { $_->name } @{$nodes_hr->{$node_name}->line}),
				(join ', ', sort @links),
			];
			push @data, $data_ar;

			# Maximum data length.
			foreach my $i (0 .. $#{$data_ar}) {
				if (length $data_ar->[$i] > $data_len[$i]) {
					$data_len[$i] = length $data_ar->[$i];
				}
			}
		}
	}

	# Print and return table.
	return table($JUNCTIONS, \@data_len, \@title, \@data);
}

# Print line.
sub line {
	my ($self, $line) = @_;

	# Get data.
	my @data;
	my @title = ($STATION, $CONNECTED_TO);
	if ($self->{'print_id'}) {
		unshift @title, $ID;
	}
	my @data_len = map { length $_ } @title;
	my $nodes_hr = $self->{'tube'}->nodes;
	foreach my $node_name (sort keys %{$nodes_hr}) {
		if (any { $_ eq $line } map { $_->name }
			@{$nodes_hr->{$node_name}->line}) {

			# Get data.
			my @links = map { $self->{'tube'}->get_node_by_id($_)->name }
				split m/,/ms, $nodes_hr->{$node_name}->link;
			my $data_ar = [
				$nodes_hr->{$node_name}->name,
				(join ', ', sort @links),
			];
			if ($self->{'print_id'}) {
				unshift @{$data_ar}, $nodes_hr->{$node_name}->id,
			}
			push @data, $data_ar;

			# Maximum data length.
			foreach my $i (0 .. $#{$data_ar}) {
				if (length $data_ar->[$i] > $data_len[$i]) {
					$data_len[$i] = length $data_ar->[$i];
				}
			}
		}
	}

	# Print and return table.
	return table($LINE." '$line'", \@data_len, \@title, \@data);
}

# Get lines.
sub lines {
	my $self = shift;
	my $lines_ar = $self->{'tube'}->get_lines;
	my $length = 0;
	my @data;
	foreach my $line (sort @{$lines_ar}) {
		push @data, [$line];
		if (length $line > $length) {
			$length = length $line;
		}
	}
	return table($LINES, [$length], undef, \@data);
}

# Print all.
sub print {
	my $self = shift;
	my $ret = $self->junctions;
	foreach my $line (@{$self->{'tube'}->get_lines}) {
		$ret .= $self->line($line->name);
	}
	return $ret;
}

1;

__END__

=encoding utf8

=head1 NAME

Map::Tube::Text::Table - Table output for Map::Tube.

=head1 SYNOPSIS

 use Map::Tube::Text::Table;