File Coverage

blib/lib/Dist/Metadata/Dir.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	8	8	100.0
condition			n/a
subroutine	15	15	100.0
pod	8	8	100.0
total	80	80	100.0

# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of Dist-Metadata
#
# This software is copyright (c) 2011 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;

package Dist::Metadata::Dir;
our $AUTHORITY = 'cpan:RWSTAUNER';
# ABSTRACT: Enable Dist::Metadata for a directory
$Dist::Metadata::Dir::VERSION = '0.927';
use Carp qw(croak carp);    # core
use File::Find ();          # core
use Path::Class 0.24 ();
use parent 'Dist::Metadata::Dist';

push(@Dist::Metadata::CARP_NOT, __PACKAGE__);


sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);

  # fix up dir (for example chop trailing slash if present)
  $self->{dir} = $self->path_class_dir->new($self->{dir})->stringify;

  # TODO: croak if not -d $self->dir

  return $self;
}

sub required_attribute { 'dir' }


sub determine_name_and_version {
  my ($self) = @_;
  # 'root' may be more accurate than 'dir'
  $self->SUPER::determine_name_and_version();
  $self->set_name_and_version( $self->parse_name_and_version( $self->dir ) );
  return;
}


sub dir {
  $_[0]->{dir};
}

# this shouldn't be called
sub extract_into {
  croak q[A directory doesn't need to be extracted];
}


sub file_content {
  my ($self, $file) = @_;
  # This is a directory so file spec will always be native
  my $path = $self->path_class_file
    ->new( $self->{dir}, $self->full_path($file) )->stringify;

  open(my $fh, '<', $path)
    or croak "Failed to open file '$path': $!";

  return do { local $/; <$fh> };
}


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

  my $dir = $self->{dir};
  my @files;

  File::Find::find(
    {
      wanted => sub {
        push @files, $self->path_class_file->new($_)->relative($dir)->stringify
          if -f $_;
      },
      no_chdir => 1
    },
    $dir
  );

  return @files;
}


sub physical_directory {
  my ($self, @files) = @_;

  # TODO: return absolute_path?
  my @parts = $self->{dir};
  # go into root dir if there is one
  push @parts, $self->root
    if $self->root;

  my $dir = $self->path_class_dir->new(@parts)->absolute;

  return $dir->stringify unless wantarray;

  return map { $_->stringify }
    ($dir, map { $dir->file( $_ ) } @files);
}

1;

__END__