File Coverage

blib/lib/CPAN/PackageDetails/Header.pm

Criterion	Covered	Total	%
statement	60	65	92.3
branch	11	14	78.5
condition	5	6	83.3
subroutine	15	17	88.2
pod	8	9	88.8
total	99	111	89.1

package CPAN::PackageDetails::Header;
use strict;
use warnings;

our $VERSION = '0.261';

use Carp;

=encoding utf8

=head1 NAME

CPAN::PackageDetails::Header - Handle the header of 02packages.details.txt.gz

=head1 SYNOPSIS

Used internally by CPAN::PackageDetails

=head1 DESCRIPTION

The 02packages.details.txt.gz header is a short preamble that give information
about the creation of the file, its intended use, and the number of entries in
the file. It looks something like:

	File:         02packages.details.txt
	URL:          http://www.perl.com/CPAN/modules/02packages.details.txt
	Description:  Package names found in directory $CPAN/authors/id/
	Columns:      package name, version, path
	Intended-For: Automated fetch routines, namespace documentation.
	Written-By:   Id: mldistwatch.pm 1063 2008-09-23 05:23:57Z k
	Line-Count:   59754
	Last-Updated: Thu, 23 Oct 2008 02:27:36 GMT

Note that there is a Columns field. This module tries to respect the ordering
of columns in there. The usual CPAN tools expect only three columns and in the
order in this example, but C tries to handle any number
of columns in any order.

=head2 Methods

=over 4

=item new( HASH )

Create a new Header object. Unless you want a lot of work so you
get more control, just let C's C or C
handle this for you.

In most cases, you'll want to create the Entries object first then
pass a reference the the Entries object to C since the header
object needs to know how to get the count of the number of entries
so it can put it in the "Line-Count" header.

	CPAN::PackageDetails::Header->new(
		_entries => $entries_object,
		)

=cut

sub new {
	my( $class, %args ) = @_;

	my %hash = (
		_entries => undef,
		%args
		);

	bless \%hash, $_[0]
	}

=item format_date

Write the date in PAUSE format. For example:

	Thu, 23 Oct 2008 02:27:36 GMT

=cut

sub format_date {
	my( $second, $minute, $hour, $date, $monnum, $year, $wday )  = gmtime;
	$year += 1900;

	my $day   = ( qw(Sun Mon Tue Wed Thu Fri Sat) )[$wday];
	my $month = ( qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) )[$monnum];

	sprintf "%s, %02d %s %4d %02d:%02d:%02d GMT",
		$day, $date, $month, $year, $hour, $minute, $second;
	}

=item default_headers

Returns a list of the the headers that should show up in the file. This
excludes various fake headers stored in the object.

=cut

sub default_headers {
	map { $_, $_[0]->{$_} }
		grep ! /^_|_class|allow/, keys %{ $_[0] }
	}

sub can {
	my( $self, @methods ) = @_;

	my $class = ref $self || $self; # class or instance

	foreach my $method ( @methods ) {
		next if
			defined &{"${class}::$method"} ||
			$self->header_exists( $method );
		return 0;
		}

	return 1;
	}

=item set_header

Add an entry to the collection. Call this on the C
object and it will take care of finding the right handler.

=cut

sub set_header {
	my( $self, $field, $value ) = @_;

	$self->{$field} = $value;
	}

=item header_exists( FIELD )

Returns true if the header has a field named FIELD, regardless of
its value.

=cut

sub header_exists {
	my( $self, $field ) = @_;

	exists $self->{$field}
	}

=item get_header( FIELD )

Returns the value for the named header FIELD. Carps and returns nothing
if the named header is not in the object. This method is available from
the C or C object:

	$package_details->get_header( 'url' );

	$package_details->header->get_header( 'url' );

The header names in the Perl code are in a different format than they
are in the file. See C for an explanation of the
difference.

For most headers, you can also use the header name as the method name:

	$package_details->header->url;

=cut

sub get_header {
	my( $self, $field ) = @_;

	if( $self->header_exists( $field ) ) { $self->{$field} }
	else { carp "No such header as $field!"; return }
	}

=item columns_as_list

Returns the columns name as a list (rather than a comma-joined string). The
list is in the order of the columns in the output.

=cut

sub columns_as_list { split /,\s+/, $_[0]->{columns} }

=item as_string

Return the header formatted as a string.

=cut

BEGIN {
my %internal_field_name_mapping = (
	url => 'URL',
	);

my %external_field_name_mapping = reverse %internal_field_name_mapping;

sub _internal_name_to_external_name {
	my( $self, $internal ) = @_;

	return $internal_field_name_mapping{$internal}
		if exists $internal_field_name_mapping{$internal};

	(my $external = $internal) =~ s/_/-/g;
	$external =~ s/^(.)/ uc $1 /eg;
	$external =~ s/-(.)/ "-" . uc $1 /eg;

	return $external;
	}

sub _external_name_to_internal_name {
	my( $self, $external ) = @_;

	return $external_field_name_mapping{$external}
		if exists $external_field_name_mapping{$external};

	(my $internal = $external) =~ s/-/_/g;

	lc $internal;
	}

sub as_string {
	my( $self, $line_count ) = @_;

	# XXX: need entry count
	my @lines;
	foreach my $field ( keys %$self ) {
		next if substr( $field, 0, 1 ) eq '_';
		my $value = $self->get_header( $field );

		my $out_field = $self->_internal_name_to_external_name( $field );

		push @lines, "$out_field: $value";
		}

	push @lines, "Line-Count: " . $self->_entries->as_unique_sorted_list
		unless $self->header_exists( 'line_count' );

	join "\n", sort( @lines ), "\n";
	}
}

sub AUTOLOAD {
	my $self = shift;

	( my $method = $CPAN::PackageDetails::Header::AUTOLOAD ) =~ s/.*:://;

	carp "No such method as $method!" unless $self->can( $method );

	$self->get_header( $method );
	}

sub DESTROY { }

=back

=head1 TO DO


=head1 SEE ALSO


=head1 SOURCE AVAILABILITY

This source is in Github:

	https://github.com/briandfoy/cpan-packagedetails

=head1 AUTHOR

brian d foy, C<<  >>

=head1 COPYRIGHT AND LICENSE

Copyright © 2009-2018, brian d foy . All rights reserved.

You may redistribute this under the terms of the Artistic License 2.0.

=cut

1;