File Coverage

blib/lib/Interchange6/Schema/ResultSet/UriRedirect.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch	6	6	100.0
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	37	37	100.0

use utf8;

package Interchange6::Schema::ResultSet::UriRedirect;

=head1 NAME

Interchange6::Schema::ResultSet::UriRedirect

=cut

=head1 SYNOPSIS

Provides extra accessor methods for L<Interchange6::Schema::Result::UriRedirect>

=cut

use strict;
use warnings;
use mro 'c3';

use parent 'Interchange6::Schema::ResultSet';

=head1 METHODS

=head2 redirect( $source_uri )

Find L<Interchange6::Schema::Result::UriRedirect/uri_source> and check
for circular redirects. In the event that a non-circular chain of redirects
is found the last item found is returned.

Returns depend on what is found:

=over 4

=item C<$source_uri> is not found

Returns undef.

=item Circular redirect found

Returns undef.

=item Normal redirect found

Returns the corresponding
L<Interchange6::Schema::Result::UriRedirect/uri_target> and
L<Interchange6::Schema::Result::UriRedirect/status_code> as an array
in list context or as an array reference in scalar context.

=back

=cut

sub redirect {
    my $self       = shift;
    my $uri_source = shift;

    my $result = $self->find( { uri_source => $uri_source } );

    return undef unless defined $result;

    while ( my $next = $self->find( { uri_source => $result->uri_target } ) )
    {
        # return on circular redirect
        return undef if $uri_source eq $next->uri_target;
        $result = $next;
    }

    my @ret = ( $result->uri_target, $result->status_code );

    return wantarray ? @ret : \@ret;
}

1;