view release on metacpan or  search on metacpan

lib/JIRA/REST/Class/Mixins.pm  view on Meta::CPAN

}

#---------------------------------------------------------------------------

#pod =begin testing cosmetic_copy 3
#pod
#pod my @PROJ = InlineTest->project_data;
#pod my $orig = [ @PROJ ];
#pod my $copy = JIRA::REST::Class::Mixins->cosmetic_copy($orig);
#pod
#pod is_deeply( $orig, $copy, "simple cosmetic copy has same content as original" );
#pod
#pod cmp_ok( refaddr($orig), 'ne', refaddr($copy),
#pod         "simple cosmetic copy has different address as original" );
#pod
#pod # make a complex reference to copy
#pod my $factory = get_factory();
#pod $orig = [ map { $factory->make_object('project', { data => $_ }) } @PROJ ];
#pod $copy = JIRA::REST::Class::Mixins->cosmetic_copy($orig);
#pod
#pod is_deeply( $copy, [
#pod   "JIRA::REST::Class::Project->name(JIRA::REST::Class)",
#pod   "JIRA::REST::Class::Project->name(Kanban software development sample project)",
#pod   "JIRA::REST::Class::Project->name(PacKay Productions)",
#pod   "JIRA::REST::Class::Project->name(Project Management Sample Project)",
#pod   "JIRA::REST::Class::Project->name(Scrum Software Development Sample Project)"
#pod ], "complex cosmetic copy is properly serialized");
#pod
#pod =end testing
#pod
#pod =cut

#---------------------------------------------------------------------------

sub __cosmetic_copy {
    my $thing = shift;
    my $top   = pop;

    if ( not ref $thing ) {
        return $thing;
    }

    my $hash_copy = sub { };

    if ( my $class = blessed $thing ) {
        if ( $class eq 'JSON::PP::Boolean' ) {
            return $thing ? 'JSON::PP::true' : 'JSON::PP::false';
        }
        if ( $class eq 'JSON' ) {
            return "$thing";
        }
        if ( $class eq 'REST::Client' ) {
            return '%s->host(%s)', $class, $thing->getHost;
        }
        if ( $class eq 'DateTime' ) {
            return "DateTime(  $thing  )";
        }
        if ( $top ) {
            if ( reftype $thing eq 'ARRAY' ) {
                chomp( my $data = Dumper( __array_copy( $thing ) ) );
                return "bless( $data => $class )";
            }
            if ( reftype $thing eq 'HASH' ) {
                chomp( my $data = Dumper( __hash_copy( $thing ) ) );
                return "bless( $data => $class )";
            }
            return Dumper( $thing );
        }
        else {
            my $fallback;

            # see if the object has any of these methods
            foreach my $method ( qw/ name key id / ) {
                if ( $thing->can( $method ) ) {
                    my $value = $thing->$method;

                    # if the method returned a value, great!
                    return sprintf '%s->%s(%s)', $class, $method, $value
                        if defined $value;

                    # we can use it as a stringification if we have to
                    $fallback //= sprintf '%s->%s(undef)', $class, $method;
                }
            }

            # fall back to either a $class->$method(undef)
            # or the default stringification
            return $fallback ? $fallback : "$thing";
        }
    }

    if ( ref $thing eq 'SCALAR' ) {
        return $$thing;
    }
    elsif ( ref $thing eq 'ARRAY' ) {
        return __array_copy( $thing );
    }
    elsif ( ref $thing eq 'HASH' ) {
        return __hash_copy( $thing );
    }
    return $thing;
}

sub __array_copy {
    my $thing = shift;
    return [ map { __cosmetic_copy( $_ ) } @$thing ];
}

sub __hash_copy {
    my $thing = shift;
    return +{ map { $_ => __cosmetic_copy( $thing->{$_} ) } keys %$thing };
}

###########################################################################
#
# internal helper functions

# accepts a reference to an array and a list of known arguments.
#
# + if the array has a single element and it's a hashref, it moves
#   elements based on the argument list from that hashref into a
#   result hashref and then complains if there are elements in the
#   first hashref left over.
#
# + if the array has multiple elements, it assigns the elements to