File Coverage

blib/lib/Maypole/Plugin/LinkTools.pm

Criterion	Covered	Total	%
statement	6	47	12.7
branch	0	24	0.0
condition	0	25	0.0
subroutine	2	7	28.5
pod	5	5	100.0
total	13	108	12.0

package Maypole::Plugin::LinkTools;

use warnings;
use strict;

our $VERSION = '0.21';

=head1 NAME

Maypole::Plugin::LinkTools - convenient link construction

=head1 SYNOPSIS

    use Maypole::Application qw( LinkTools );

    #...

    print $request->maybe_link_view( $thing );

    print $request->maybe_many_link_views( @things );

    print $request->link( table      => $table,
                          action     => $action,        # called 'command' in the original link template
                          additional => $additional,    # optional - generally an object ID
                          label      => $label,
                          );

    print $request->make_path( table      => $table,
                               action     => $action,        # called 'command' in the original link template
                               additional => $additional,    # optional - generally an object ID
                               );


=head1 DESCRIPTION

Provides convenient replacements for the C and C templates, and a new
C method.

Centralises all path manipulation, so that a new URI scheme can be implemented site-wide by
overriding just two methods (C and C).

For ease of use with the Template Toolkit, C, C and
C will also accept a hashref of arguments. For example:

    print $request->make_path({ table      => $table,
                                action     => $action,
                                additional => $additional,
                             });

=head1 METHODS

=over 4

=item make_path( %args or \%args )

This is the counterpart to C. It generates a path to use in links,
form actions etc. To implement your own path scheme, just override this method and C.

    %args = ( table      => $table,
              action     => $action,        # called 'command' in the original link template
              additional => $additional,    # optional - generally an object ID
              );

C can be used as an alternative key to C.

=cut

# TODO:
# C<$additional> can be a string, an arrayref, or a hashref. An arrayref is expanded into extra
# path elements, whereas a hashref is translated into a query string.
sub make_path
{
    my $r = shift;
    my %args = (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    do { die "no $_" unless $args{ $_ } } for qw( table
                                                  action
                                                  );

    my $base = $r->config->uri_base;
    $base = '' if $base eq '/';

    $args{additional} ||= $args{id};
    my $add = $args{additional} ? "/$args{additional}" : '';

    return sprintf '%s/%s/%s%s', $base, $args{table}, $args{action}, $add;
}

=item link( %args or \%args )

Returns a link, calling C to generate the path.

    %args = ( table      => $table,
              action     => $action,        # called 'command' in the original link template
              additional => $additional,    # optional - generally an object ID
              label      => $label,
              );

The table can be omitted and defaults to that of the request's model.
C can be used as an alternative key to C.

=cut

sub link
{
    my $r = shift;
    my %args = (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    $args{table} ||= $r->model_class->table;
    $args{label} ||= '...'; # in case a stringify column is left empty

    foreach my $key ( qw( table action ) )
    {
        die sprintf "link: no %s (got table: %s action: %s label: %s)",
            $key, $args{table} || '', $args{action} || '', $args{label} || ''
                unless $args{ $key };
    }

    my $path = $r->make_path( %args );

    return sprintf '%s', $path, $args{label};
}

=item link_view( $thing or %args or \%args )

Build a link to the C action of the given item.
If passed a Maypole request object, builds a link to its C action.

    print $request->link_view( $maypole_request );

    print $request->link_view( table      => $table,
                               label      => $label,
                               additional => $id,
                               );

=cut

sub link_view
{
    my $r = shift;

    my %args;

    if ( @_ == 1 )
    {
        die "single argument to link_view() must be a reference (got $_[0])" unless ref $_[0];

        if ( ref $_[0] eq 'HASH' )
        {
            %args = %{ $_[0] };
        }
        elsif ( UNIVERSAL::isa( $_[0], 'Maypole::Model::Base' ) )
        {
            my $object = shift;

            my $str = ''.$object;
            warn sprintf "%s (id: %s) object has no data for stringification", ref($object), $object->id unless $str;
            $str ||= '...';

            %args = ( table      => $object->table,
                      additional => $object->id,
                      label      => $str,
                      );
        }
        else
        {
            die "unsuitable single argument to link_view (got $_[0]) - need hashref or Maypole/CDBI object";
        }
    }
    else
    {
        %args = @_;
    }

    return $r->link( %args, action => 'view' );
}

=item maybe_link_view( $thing )

Returns stringified C<$thing> unless it isa C object, in which case
a link to the view template for the object is returned.

=cut

sub maybe_link_view
{
    my ( $r, $thing ) = @_;

    if ( ref $thing and UNIVERSAL::isa( $thing, 'Maypole::Model::Base' ) )
    {
        return $r->link_view( $thing );
    }
    else
    {
        return ''.$thing;
    }
}

=item maybe_many_link_views

Runs multiple items through C, returning a list.

=cut

# if the accessor is for a has_many relationship, it might return multiple items, which
# would each be passed individually to maybe_link_view(), and then each would go in its
# own column. Instead, we want a list of items to put in a single cell.
sub maybe_many_link_views
{
    my ( $r, @values ) = @_;

    return map { $r->maybe_link_view( $_ ) } @values;
}



=back

=head1 AUTHOR

David Baird, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2005 David Baird, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Maypole::Plugin::LinkTools