package Test::CPAN::Health::Distribution;

use strict;
use warnings;
use autodie qw(:all);

use Carp qw(croak carp);
use File::Find::Rule;
use File::Spec;
use Readonly;
use Params::Validate::Strict qw(validate_strict);

our $VERSION = '0.1.0';

Readonly::Scalar my $METACPAN_API => 'https://fastapi.metacpan.org/v1';

=head1 NAME

Test::CPAN::Health::Distribution - Represents a CPAN distribution under analysis

=head1 SYNOPSIS

    use Test::CPAN::Health::Distribution;

    # From a local unpacked path
    my $dist = Test::CPAN::Health::Distribution->new(path => '/tmp/LWP-UserAgent-6.77');

    # From a CPAN distribution name (downloads and unpacks)
    my $dist = Test::CPAN::Health::Distribution->from_cpan('LWP-UserAgent');

    # From a module name (resolves dist via MetaCPAN, then downloads)
    my $dist = Test::CPAN::Health::Distribution->from_module('LWP::UserAgent');

    printf "%s %s by %s\n", $dist->name, $dist->version, $dist->author;
    my @pm_files = @{ $dist->pm_files };

=head1 DESCRIPTION

Abstracts the distribution being analysed.  All checks receive a
Distribution object, which provides uniform access to the filesystem,
metadata, and derived file lists regardless of whether the distribution
came from a local path or was downloaded from CPAN.

All file-list methods return absolute paths.

=head1 LIMITATIONS

=over 4

=item * C<from_cpan> and C<from_module> require network access and
C<Archive::Tar> to unpack tarballs.  The download is cached in a
temporary directory that is cleaned up at object destruction.

=item * C<meta> searches in order: META.json, META.yml, MYMETA.json, MYMETA.yml.
MYMETA files are generated by C<perl Makefile.PL> and serve as a fallback
for local checkouts.  Canonical META files are produced by C<make distdir>
(MakeMaker) or C<dzil build> (Dist::Zilla) and must be committed separately.
Returns C<undef> only when none of these files are present.

=item * C<file_path> does not sanitise C<@parts> for path-traversal sequences
(e.g. C<../>).  It is the caller's responsibility to supply trusted path
components.  Do not pass user-supplied strings to C<file_path> without prior
validation.

=item * C<all_source_files> returns the union of C<pm_files> and C<pl_files>
at the time of the first call; the result is cached.  Files added to the
distribution tree afterwards are not visible.

=back

=cut

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

	%args = %{ validate_strict(
		schema => {
			path => { type => 'string', min => 1 },
		},
		input => \%args,
	) };

	croak "Distribution path '$args{path}' does not exist"
		unless -d $args{path};

	my $self = bless {
		_path              => File::Spec->rel2abs($args{path}),
		_meta              => undef,
		_pm_files          => undef,
		_t_files           => undef,
		_pl_files          => undef,
		_all_source_files  => undef,    # cached union of pm_files and pl_files
		_name              => undef,
		_version_loaded    => 0,        # true once version() has been computed
		_version           => undef,
		_author_loaded     => 0,        # true once author() has been computed
		_author            => undef,
		_tmp_dir           => undef,    # set by factory methods; owned for cleanup
	}, $class;

	return $self;
}

=head2 from_cpan

=head3 PURPOSE

Factory method: resolve a CPAN distribution name to the latest release,
download the tarball via MetaCPAN, unpack it to a temp directory, and
return a Distribution instance pointing at the unpacked tree.

=head3 API SPECIFICATION

=head4 INPUT

  dist_name  Scalar  required  e.g. 'LWP-UserAgent'

=head4 OUTPUT

L<Test::CPAN::Health::Distribution> object.

=head3 MESSAGES

  Code  | Severity | Message                            | Resolution
  ------+----------+------------------------------------+---------------------
  DST01 | FATAL    | Cannot resolve dist from MetaCPAN  | Check dist name and network
  DST02 | FATAL    | Download failed                    | Check CPAN mirror availability
  DST03 | FATAL    | Unpack failed                      | Check Archive::Tar installation

=head3 FORMAL SPECIFICATION

  -- Z schema (placeholder) --
  FromCpanOp
  dist_name? : String
  dist!      : Distribution
  -------------------------------------------------------
  dist_name? /= ""
  dist!.name = resolve(dist_name?)
  exists(dist!.path) /\ is_dir(dist!.path)

=head3 SIDE EFFECTS

Downloads a tarball from CPAN.  Creates and owns a temporary directory
that is removed when the returned object is destroyed.

=head3 USAGE EXAMPLE

    my $dist = Test::CPAN::Health::Distribution->from_cpan('LWP-UserAgent');

=cut

sub from_cpan {
	my ($class, $dist_name) = @_;

	croak 'dist_name is required' unless defined $dist_name && length $dist_name;

	# Strategy:
	#   1. Hit MetaCPAN /release/{dist_name} to get download_url and author.
	#   2. Fetch the tarball with HTTP::Tiny.
	#   3. Unpack with Archive::Tar into a File::Temp::tempdir.
	#   4. Construct and return a Distribution with _tmp_dir set for cleanup.

	require HTTP::Tiny;
	require JSON::MaybeXS;
	require Archive::Tar;
	require File::Temp;

	my $ua  = HTTP::Tiny->new(timeout => 30);
	my $url = "$METACPAN_API/release/$dist_name";
	my $res = $ua->get($url);

	croak "Cannot resolve '$dist_name' from MetaCPAN (HTTP $res->{status})"
		unless $res->{success};

	my $data         = JSON::MaybeXS::decode_json($res->{content});
	my $download_url = $data->{download_url}
		or croak "MetaCPAN returned no download_url for '$dist_name'";

	my $tarball_res = $ua->get($download_url);
	croak "Download failed for '$download_url' (HTTP $tarball_res->{status})"
		unless $tarball_res->{success};

	my $tmp_dir = File::Temp::tempdir(CLEANUP => 0);    # we manage cleanup

	my $tar = Archive::Tar->new;
	$tar->read(\$tarball_res->{content}, 1);            # 1 = compressed
	$tar->extract_archive($tmp_dir)
		or croak "Unpack failed: " . Archive::Tar->error;

	# The tarball unpacks to a single top-level directory (Dist-Name-X.Y).
	my ($unpack_dir) = glob "$tmp_dir/*";
	croak "Unexpected tarball structure in '$tmp_dir'" unless defined $unpack_dir && -d $unpack_dir;

	my $self = $class->new(path => $unpack_dir);
	$self->{_tmp_dir} = $tmp_dir;

	return $self;
}

=head2 from_module

=head3 PURPOSE

Factory method: resolve a module name (C<Foo::Bar>) to its containing
distribution via MetaCPAN, then delegate to C<from_cpan>.

=head3 API SPECIFICATION

=head4 INPUT

  module_name  Scalar  required  e.g. 'LWP::UserAgent'

=head4 OUTPUT

L<Test::CPAN::Health::Distribution> object.

=head3 MESSAGES

  Code  | Severity | Message                            | Resolution
  ------+----------+------------------------------------+---------------------
  DST04 | FATAL    | Cannot resolve module from MetaCPAN | Check module name and network

=head3 FORMAL SPECIFICATION

  -- Z schema (placeholder) --
  FromModuleOp
  module_name? : String
  dist_name!   : String
  -------------------------------------------------------
  dist_name! = metacpan_resolve(module_name?)

=head3 SIDE EFFECTS

As C<from_cpan>.

=head3 USAGE EXAMPLE

    my $dist = Test::CPAN::Health::Distribution->from_module('LWP::UserAgent');

=cut

sub from_module {
	my ($class, $module_name) = @_;

	croak 'module_name is required' unless defined $module_name && length $module_name;

	require HTTP::Tiny;
	require JSON::MaybeXS;

	my $ua  = HTTP::Tiny->new(timeout => 30);
	my $url = "$METACPAN_API/module/$module_name";
	my $res = $ua->get($url);

	croak "Cannot resolve module '$module_name' from MetaCPAN (HTTP $res->{status})"
		unless $res->{success};

	my $data      = JSON::MaybeXS::decode_json($res->{content});
	my $dist_name = $data->{distribution}
		or croak "MetaCPAN returned no distribution for module '$module_name'";

	return $class->from_cpan($dist_name);
}

# ---------------------------------------------------------------------------
# Accessors -- all lazy, computed once and cached
# ---------------------------------------------------------------------------

=head2 path

=head3 PURPOSE

Returns the absolute filesystem path to the root of the unpacked distribution.

=head3 API SPECIFICATION

=head4 INPUT

None.

=head4 OUTPUT

Absolute scalar path string.

=head3 MESSAGES

  Code  | Severity | Message                            | Resolution
  ------+----------+------------------------------------+---------------------
        |          |                                    |

=head3 FORMAL SPECIFICATION

  -- Z schema (placeholder) --
  path : String
  -------------------------------------------------------
  is_absolute(path) /\ is_dir(path)

=head3 SIDE EFFECTS

None.

=head3 USAGE EXAMPLE

    print $dist->path;

=cut

sub path { my ($self) = @_; return $self->{_path} }

=head2 meta

=head3 PURPOSE

Returns a L<CPAN::Meta> object parsed from the best available META file.
The search order is: META.json, META.yml, MYMETA.json, MYMETA.yml.
META files are authoritative (shipped with the dist); MYMETA files are
generated by C<perl Makefile.PL> and used as a fallback for local
checkouts where C<perl Makefile.PL> has been run but no canonical META
file has been committed.  Returns C<undef> if no
META file of any kind is found.

=head3 API SPECIFICATION

=head4 INPUT

None.

=head4 OUTPUT

L<CPAN::Meta> object or C<undef>.

=head3 MESSAGES

  Code  | Severity | Message                              | Resolution
  ------+----------+--------------------------------------+---------------------
  DST05 | WARNING  | Cannot parse <file>: <reason>        | Fix or regenerate the META file

=head3 FORMAL SPECIFICATION

  -- Z schema (placeholder) --
  meta : CPAN::Meta | undefined

=head3 SIDE EFFECTS

None (reads META file on first call, caches result).

=head3 USAGE EXAMPLE

    my $meta = $dist->meta or warn "No META file";
    print $meta->name;

=cut

sub meta {
	my ($self) = @_;

	return $self->{_meta} if defined $self->{_meta};

	require CPAN::Meta;

	for my $basename (qw(META.json META.yml MYMETA.json MYMETA.yml)) {
		my $file = File::Spec->catfile($self->{_path}, $basename);
		next unless -f $file;
		eval { $self->{_meta} = CPAN::Meta->load_file($file); 1 }
			or carp "Cannot parse $basename: $@";
		last if $self->{_meta};
	}

	return $self->{_meta};
}

=head2 name

Returns the distribution name from META (e.g. C<LWP-UserAgent>), or a
best-guess derived from the path basename if META is absent.

=cut

sub name {
	my ($self) = @_;

	unless (defined $self->{_name}) {
		my $meta = $self->meta;
		my $meta_name = $meta ? $meta->name : undef;
		$self->{_name} = (defined $meta_name && length $meta_name) ? $meta_name : do {
			my $base = (File::Spec->splitpath($self->{_path}))[2];
			$base =~ s/ - [0-9] [0-9._]* $ //x;
			$base;
		};
	}

	return $self->{_name};
}

=head2 version

Returns the distribution version string from META, or C<undef> if not
determinable.  The result is cached after the first call; a dist whose
META lacks a version field always returns C<undef> without re-parsing.

=cut

sub version {
	my ($self) = @_;

	# Use a loaded-flag rather than defined() so that undef (a legitimate
	# result when META has no version) is itself cached and not recomputed.
	unless ($self->{_version_loaded}) {
		my $meta = $self->meta;
		$self->{_version}        = $meta ? $meta->version : undef;
		$self->{_version_loaded} = 1;
	}

	return $self->{_version};
}

=head2 author

Returns the first author string from META, or C<undef>.  Cached after
the first call.

=cut

sub author {
	my ($self) = @_;

	# Loaded-flag pattern for the same reason as version() above.
	unless ($self->{_author_loaded}) {
		my $meta = $self->meta;
		if ($meta) {
			my @authors = $meta->author;
			$self->{_author} = $authors[0];
		}
		$self->{_author_loaded} = 1;
	}

	return $self->{_author};
}

=head2 pm_files

Returns an arrayref of absolute paths to all C<.pm> files under C<lib/>.

=cut

sub pm_files {
	my ($self) = @_;

	$self->{_pm_files} //= [
		File::Find::Rule->file->name('*.pm')
			->in(File::Spec->catdir($self->{_path}, 'lib'))
	];

	return $self->{_pm_files};
}

=head2 t_files

Returns an arrayref of absolute paths to all C<.t> files under C<t/>.

=cut

sub t_files {
	my ($self) = @_;

	$self->{_t_files} //= [
		File::Find::Rule->file->name('*.t')
			->in(File::Spec->catdir($self->{_path}, 't'))
	];

	return $self->{_t_files};
}

=head2 pl_files

Returns an arrayref of absolute paths to all C<.pl> files and files under C<bin/> or C<script/>.

=cut

sub pl_files {
	my ($self) = @_;

	unless (defined $self->{_pl_files}) {
		my @files = File::Find::Rule->file->name('*.pl')->in($self->{_path});
		for my $dir (qw(bin script)) {
			my $full = File::Spec->catdir($self->{_path}, $dir);
			push @files, File::Find::Rule->file->in($full) if -d $full;
		}
		$self->{_pl_files} = \@files;
	}

	return $self->{_pl_files};
}

=head2 all_source_files

Convenience: returns the union of C<pm_files> and C<pl_files> as a single
arrayref.  The result is cached after the first call.

=cut

sub all_source_files {
	my ($self) = @_;

	# Cache the union to avoid rescanning directories on repeated calls.
	$self->{_all_source_files} //= [ @{$self->pm_files}, @{$self->pl_files} ];

	return $self->{_all_source_files};
}

=head2 has_dir

Returns true if the given subdirectory exists within the distribution root.
Accepts a single directory name or a list of alternatives.

=cut

sub has_dir {
	my ($self, @names) = @_;

	for my $name (@names) {
		return 1 if -d File::Spec->catdir($self->{_path}, $name);
	}

	return 0;
}

=head2 file_path

Returns the absolute path to a named file within the distribution root, or
C<undef> if it does not exist.

=cut

sub file_path {
	my ($self, @parts) = @_;

	my $abs = File::Spec->catfile($self->{_path}, @parts);

	return -e $abs ? $abs : undef;
}

sub DESTROY {
	my ($self) = @_;

	# Clean up temp directories created by factory methods.
	if (defined $self->{_tmp_dir} && -d $self->{_tmp_dir}) {
		require File::Path;
		File::Path::remove_tree($self->{_tmp_dir});
	}

	return;
}

=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2025-2026 Nigel Horne.

This program 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 2 of the License, or (at your option)
any later version.

=cut

1;
