File Coverage

blib/lib/Venus/Name.pm

Criterion	Covered	Total	%
statement	68	72	94.4
branch	10	12	83.3
condition	1	2	50.0
subroutine	22	23	95.6
pod	14	15	93.3
total	115	124	92.7

package Venus::Name;

use 5.018;

use strict;
use warnings;

use Venus::Class 'base', 'with';

base 'Venus::Kind::Utility';

with 'Venus::Role::Valuable';
with 'Venus::Role::Buildable';
with 'Venus::Role::Accessible';
with 'Venus::Role::Explainable';

use overload (
  '""' => 'explain',
  'eq' => sub{$_[0]->value eq "$_[1]"},
  'ne' => sub{$_[0]->value ne "$_[1]"},
  'qr' => sub{qr/@{[quotemeta($_[0]->value)]}/},
  '~~' => 'explain',
  fallback => 1,
);

my $sep = qr/'|__|::|\\|\//;

# BUILDERS

sub build_arg {
  my ($self, $data) = @_;

  return {
    value => $data,
  };
}

# METHODS

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

  my $assert = $self->SUPER::assertion;

  $assert->clear->expression('string');

  return $assert;
}

sub default {
  return 'Venus';
}

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

  return $self->label =~ s/_/-/gr;
}

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

  return $self->get;
}

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

  return $self->get if $self->lookslike_a_file;

  my $string = $self->package;

  return join '__', map {
    join '_', map {lc} map {split /_/} grep {length}
    split /([A-Z]{1}[^A-Z]*)/
  } split /$sep/, $string;
}

sub format {
  my ($self, $method, $format) = @_;

  local $_ = $self;

  my $string = $self->$method;

  return sprintf($format || '%s', $string);
}

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

  return $self->get if $self->lookslike_a_label;

  return join '_', split /$sep/, $self->package;
}

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

  my $string = $self->get;

  return $string =~ /^[a-z](?:\w*[a-z])?$/;
}

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

  my $string = $self->get;

  return $string =~ /^[A-Z](?:\w*[a-zA-Z0-9])?$/;
}

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

  my $string = $self->get;

  return $string =~ /^[A-Z](?:(?:\w|::)*[a-zA-Z0-9])?$/;
}

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

  my $string = $self->get;

  return $string =~ /^[A-Z](?:(?:\w|\\|\/|[\:\.]{1}[a-zA-Z0-9])*[a-zA-Z0-9])?$/;
}

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

  my $string = $self->get;

  return $string =~ /^\[\w+\]$/;
}

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

  return $self->get if $self->lookslike_a_package;

  return substr($self->get, 1, -1) if $self->lookslike_a_pragma;

  my $string = $self->get;

  if ($string !~ $sep) {
    return join '', map {ucfirst} split /[^a-zA-Z0-9]/, $string;
  } else {
    return join '::', map {
      join '', map {ucfirst} split /[^a-zA-Z0-9]/
    } split /$sep/, $string;
  }
}

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

  return $self->get if $self->lookslike_a_path;

  return join '/', split /$sep/, $self->package;
}

1;



=head1 NAME

Venus::Name - Name Class

=cut

=head1 ABSTRACT

Name Class for Perl 5

=cut

=head1 SYNOPSIS

  package main;

  use Venus::Name;

  my $name = Venus::Name->new('Foo/Bar');

  # $name->package;

=cut

=head1 DESCRIPTION

This package provides methods for parsing and formatting package namespace
strings.

=cut

=head1 INHERITS

This package inherits behaviors from:

L

=cut

=head1 INTEGRATES

This package integrates behaviors from:

L

L

L

L

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 default

  default() (Str)

The default method returns the default value, i.e. C<'Venus'>.

I>

=over 4

=item default example 1

  # given: synopsis;

  my $default = $name->default;

  # "Venus"

=back

=cut

=head2 dist

  dist() (Str)

The dist method returns a package distribution representation of the name.

I>

=over 4

=item dist example 1

  # given: synopsis;

  my $dist = $name->dist;

  # "Foo-Bar"

=back

=cut

=head2 explain

  explain() (Str)

The explain method returns the package name and is used in stringification
operations.

I>

=over 4

=item explain example 1

  # given: synopsis;

  my $explain = $name->explain;

  # "Foo/Bar"

=back

=cut

=head2 file

  file() (Str)

The file method returns a file representation of the name.

I>

=over 4

=item file example 1

  # given: synopsis;

  my $file = $name->file;

  # "foo__bar"

=back

=cut

=head2 format

  format(Str $method, Str $format) (Str)

The format method calls the specified method passing the result to the core
L function with itself as an argument. This method supports
dispatching, i.e. providing a method name and arguments whose return value will
be acted on by this method.

I>

=over 4

=item format example 1

  # given: synopsis;

  my $format = $name->format('file', '%s.t');

  # "foo__bar.t"

=back

=cut

=head2 label

  label() (Str)

The label method returns a label (or constant) representation of the name.

I>

=over 4

=item label example 1

  # given: synopsis;

  my $label = $name->label;

  # "Foo_Bar"

=back

=cut

=head2 lookslike_a_file

  lookslike_a_file() (Str)

The lookslike_a_file method returns truthy if its state resembles a filename.

I>

=over 4

=item lookslike_a_file example 1

  # given: synopsis;

  my $lookslike_a_file = $name->lookslike_a_file;

  # ""

=back

=cut

=head2 lookslike_a_label

  lookslike_a_label() (Str)

The lookslike_a_label method returns truthy if its state resembles a label (or
constant).

I>

=over 4

=item lookslike_a_label example 1

  # given: synopsis;

  my $lookslike_a_label = $name->lookslike_a_label;

  # ""

=back

=cut

=head2 lookslike_a_package

  lookslike_a_package() (Str)

The lookslike_a_package method returns truthy if its state resembles a package
name.

I>

=over 4

=item lookslike_a_package example 1

  # given: synopsis;

  my $lookslike_a_package = $name->lookslike_a_package;

  # ""

=back

=cut

=head2 lookslike_a_path

  lookslike_a_path() (Str)

The lookslike_a_path method returns truthy if its state resembles a file path.

I>

=over 4

=item lookslike_a_path example 1

  # given: synopsis;

  my $lookslike_a_path = $name->lookslike_a_path;

  # 1

=back

=cut

=head2 lookslike_a_pragma

  lookslike_a_pragma() (Str)

The lookslike_a_pragma method returns truthy if its state resembles a pragma.

I>

=over 4

=item lookslike_a_pragma example 1

  # given: synopsis;

  my $lookslike_a_pragma = $name->lookslike_a_pragma;

  # ""

=back

=cut

=head2 package

  package() (Str)

The package method returns a package name representation of the name given.

I>

=over 4

=item package example 1

  # given: synopsis;

  my $package = $name->package;

  # "Foo::Bar"

=back

=cut

=head2 path

  path() (Str)

The path method returns a path representation of the name.

I>

=over 4

=item path example 1

  # given: synopsis;

  my $path = $name->path;

  # "Foo/Bar"

=back

=cut

=head1 OPERATORS

This package overloads the following operators:

=cut

=over 4

=item operation: C<(.)>

This package overloads the C<.> operator.

B

  # given: synopsis;

  my $package = $name . 'Baz';

  # "Foo::BarBaz"

=back

=over 4

=item operation: C<(eq)>

This package overloads the C operator.

B

  # given: synopsis;

  $name eq 'Foo/Bar';

  # 1

B

  package main;

  use Venus::Name;

  my $name1 = Venus::Name->new('Foo\Bar');
  my $name2 = Venus::Name->new('Foo\Bar');

  $name1 eq $name2;

  # 1

=back

=over 4

=item operation: C<(ne)>

This package overloads the C operator.

B

  # given: synopsis;

  $name ne 'Foo\Bar';

  # 1

B

  package main;

  use Venus::Name;

  my $name1 = Venus::Name->new('FooBar');
  my $name2 = Venus::Name->new('Foo_Bar');

  $name1 ne $name2;

  # 1

=back

=over 4

=item operation: C<(qr)>

This package overloads the C operator.

B

  # given: synopsis;

  "Foo/Bar" =~ qr/$name/;

  # 1

=back

=over 4

=item operation: C<("")>

This package overloads the C<""> operator.

B

  # given: synopsis;

  my $result = "$name";

  # "Foo/Bar"

B

  # given: synopsis;

  my $result = "$name, $name";

  # "Foo/Bar, Foo/Bar"

=back

=over 4

=item operation: C<(~~)>

This package overloads the C<~~> operator.

B

  # given: synopsis;

  my $result = $name ~~ 'Foo/Bar';

  # 1

=back

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Al Newkirk.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut