package Xyzzy;

use strict;
use warnings;
use B;
use B::Deparse;
use Carp;
use Devel::FindRef;
use Devel::Symdump;
use Exporter;

our @ISA       = qw( Exporter     );
our @EXPORT_OK = qw( FullyQualify );

sub FullyQualify
{
    my ($global) = @_;
    my  @return;

    if (ref $global)
    {
        if (ref $global eq 'CODE')
        {
            # $ref is a ref to an autovivified sub

            if (B::Deparse->new->coderef2text($global) eq ';')
            {
                Carp::cluck 'FullyQualifySubName was passed a coderef ' .
                            'to a sub that has been autovivified!';
            }
            else
            {
                push @return, code_ref($global);
            }
        }
        elsif ((ref $global) =~ m[ ^ (?: ARRAY | HASH | SCALAR ) $ ]x)
        {
            push @return, var_ref($global);
        }
        else
        {
            push @return, 'Your ref is a \'' .
                           join(' ', @{ [ ref $global ] }) . ' ref\'!';
        }
    }
    else    # ! ref $global
    {
        my $module;

        if ($global =~ m[^(.+)::])              # already qualified
        {
            $module = Devel::Symdump->new($1);
        }
        else                                    # in this caller
        {
            my $caller = (caller)[0];
            $module    =  Devel::Symdump->new($caller);
            $global    =  $caller . '::' . $global;
        }

        push @return, code_ref(eval '\&' . $global)
            if grep { m[ ^ $global $ ]x } $module->functions();

        push @return, var_ref (eval '\%' . $global)
            if grep { m[ ^ $global $ ]x } $module->hashes();

        push @return, var_ref (eval '\@' . $global)
            if grep { m[ ^ $global $ ]x } $module->arrays();

        push @return, var_ref (eval '\$' . $global) . (@return ? '?' : '')
            if grep { m[ ^ $global $ ]x } $module->scalars();
    }

    return @return;
}

sub code_ref
{
    my ($ref) = @_;

    return eval {
                    my $obj = B::svref_2object($ref);
                    $obj->GV->STASH->NAME . '::' . $obj->GV->NAME;
                };
}

sub var_ref
{
    my ($ref)    = @_;
    my  @globals = grep { $_->[0] =~ m[^the global] } Devel::FindRef::find($ref);

    return $globals[0]->[0] =~ s[^the global ][]r;
}

1;