view release on metacpan or  search on metacpan

lib/Data/AnyXfer/Elastic/Utils.pm  view on Meta::CPAN

If being executued within a test environment, the index name is made unique
enough to prevent clashes.

=cut

sub configure_index_name {

    my ( $class, $index_name, $hostname, $user ) = @_;

    $index_name = $class->_make_unique_name( $index_name, $hostname, $user );

    return $index_name;
}

=head2 C<configure_alias_name>

    $name = Utils->configure_alias_name('interiors');
    $names = Utils->configure_alias_name(['interiors', 'properties']);
    print $name;    # prints e.g. <user>_<hostname>_<package>_interiors.

If being executued within a test environment, the alias name is made unique
enough to prevent clashes.

=cut

sub configure_alias_name {

    my ( $class, $alias_name, $hostname, $user ) = @_;

    $alias_name = $class->_make_unique_name( $alias_name, $hostname, $user );

    return $alias_name;
}


sub _make_unique_name {

    my ( $class, $name, $hostname, $user, $caller ) = @_;

    return $name unless Data::AnyXfer->test();

    # note: arguement $hostname and $caller are solely for testing purposes
    if ( ref($name) eq 'ARRAY' ) {
        return [
            map { $class->_make_unique_name( $_, $hostname, $user, $caller ) }
                @{$name}
        ];
    } else {
        return $class->make_safe_name( $name, $hostname, $user, $caller );

    }
}

sub make_safe_name {

    my ( $self, $name, $hostname, $user, $package ) = @_;

    croak "name not supplied" unless $name;

    $hostname //= Sys::Hostname::hostname;
    $user     //= getpwuid($>) || $>;
    $package  //= $self->_find_test_package_name;

    my $safe_name
        = join( '_', grep {$_} ( $user, $hostname, $package, $name ) );

    # make the name pretty and easy to type
    $safe_name =~ s/-/_/g;    # some hostnames have dashes in them

    return $safe_name;
}


my $TEST_PKG;

sub _find_test_package_name {
    my ($class) = @_;

    return $TEST_PKG if $TEST_PKG;

    my $trace = Devel::StackTrace->new;
    my $test_frame;

    # search stack for the frame containing the .t test
    while ( my $frame = $trace->prev_frame ) {
        next
            unless $frame->package eq 'main'
            && $frame->filename =~ /\.t$/;
        $test_frame = $frame;
        last;
    }

    return unless $test_frame;    # failed to find it -- bail out

    # found the stack frame containing the .t test
    my $file = Path::Class::file( $test_frame->filename );
    my $dir  = $file->dir->absolute;

    # search up through the dir structure until we find the "t" or "xt" dir
    while () {
        last   if $dir->basename eq "t";
        last   if $dir->basename eq "xt";
        last   if $dir->basename eq "st";
              # selenium tests may not be in a t dir
        last   if $dir->parent->basename =~ /^selenium/;
              # failed -- bail out
        return if $dir eq "/";
        $dir = $dir->parent;
    }

    # found the test's package name
    $TEST_PKG = $dir->parent->basename;

    # make it pretty and easy to type
    $TEST_PKG =~ s/\d+//g;            # maya puts version number in dir name
    $TEST_PKG =~ s/\.//g;             # maya puts version number in dir name
    $TEST_PKG =~ s/-/_/g;             # maya puts dashes in dir name
    $TEST_PKG =~ s/_+/_/g;            # maya problem: just one _
    $TEST_PKG =~ s/_$//g;             # maya problem: don't end with a _
    $TEST_PKG = lc $TEST_PKG;