package Maypole::Plugin::Path::URI;

use warnings;
use strict;

use URI();

use NEXT;

our $VERSION = 0.4;
warn __PACKAGE__ ." V$VERSION\n";

=head1 NAME

Maypole::Plugin::Path::URI - generic link parsing and generation


=head1 SYNOPSIS

    use Maypole::Application qw( Path::URI );
=cut

#=======================================================================
#
# This plugin needs to initialize, but Maypole doesn't run a plugin's
# import() method, so we hi-jack Maypole's setup() method to run it ...

sub setup
{
    my $r = shift;
    
    $r->NEXT::DISTINCT::setup( @_ );	# Run BeerDB->setup, which may
					# well be Maypole::setup()
    warn __PACKAGE__ . "->import($r)" if $r->debug;

    # Make a URI object for the base URL from the configuration string
    #
    my $config_class = ref $r->config;
    $config_class->mk_accessors(qw(base_uri_obj));
    $r->config->base_uri_obj( URI->new($r->config->uri_base) );
}


#=======================================================================
#
# Split a path into table, action and extras
# 
# This code overrides the method in Maypole.pm. It's basically here to
# localize knowledge of the semantics of the URL.
#
# Ideally, we'd like to get hold of the URI that represents the request
# and extract the path directly instead of faking up a URI just so we
# can take it apart.
#
sub parse_path
{
    my $r = shift;
    my $path = $r->path || 'frontpage';
    $r->path($path);
    my $uri = URI->new($path, 'http');
    my @segments = $uri->path_segments;
    $r->table(shift @segments);
    $r->action(shift @segments);
#    $r->action} ||= "index";
    $r->args(\@segments);
}


#=======================================================================
#
#  Make a URL for a particular action on a table
#
#  INPUTS
#   $r		request object
#   $additional	additional part of path such as id (n.b. NOT query params)
#
sub make_action_uri
{
    my ($r, $additional)  = @_;

    my $uri  = $r->config->base_uri_obj->clone;
    my $path = $uri->path;	# get the base path
    $path .= '/' unless $path =~/\/$/;	# make sure there's a trailing slash
    $path .= $r->table . '/' . $r->action;
    $path .= '/' . $additional if defined $additional;
    $uri->path($path);
    return $uri;
}


#=======================================================================
#
#  Make a URL given table, action etc
#
#  INPUTS
#   $r		request object
#   @segments	list of path segments (normally table, action, etc)
#   \%query	(OPTIONAL) hash of query keys => values
#
sub make_uri
{
    my ($r, @segments) = @_;

    my $query = (ref $segments[-1] eq 'HASH') ? pop(@segments) : undef;

    my $uri = $r->config->base_uri_obj->clone;
    $uri->path_segments($uri->path_segments, @segments);
    $uri->query_form($query) if $query;
    return $uri;
}


#=======================================================================
#
#  Build clickable column headers to control sorting
#   - based on code from Ron McClain
#
# INPUTS
#  $r		request
#  $model_class	(optional) model class, otherwise extracted from request
#			   (n.b. can use zero arg in template if you want to
#			   omit the model_class but supply a list of fields)
#  $fields	(optional) list of database column names and perhaps
#  			   foreign key accessors
#
# OUTPUTS
#  Returns a list with an element for each column
#  Each element is itself a listref with two elements:
#    0  The href to sort on this column
#    1	An integer indicating the current ordering:
#          0  Not currently sorted on this column
#         -1  currently sorted on this column, in descending order
#          1  currently sorted on this column, in ascending order
#
sub make_header_links
{
    my ($r, $model_class, $fields) = @_;

    # Get the query params and extract interesting values. First take a
    # copy so we can delete things from it without removing data used
    # elsewhere
    my %params    = %{$r->params};

    # Extract the sorting details
    my $order_by  = $params{order} || '';	# column name
    my $order_dir = $params{o2}    || '';	# '' for ascending or 'desc'

    # Search forms can have an extra parameter - decode it
    ($order_by, $order_dir) = split /\s+/, $params{search_opt_order_by}
      if $params{search_opt_order_by};

    # Reverse the sort direction on the next click if it was already sorted
    $order_dir = $order_dir eq 'desc' ? '' : 'desc' if $order_by;

    delete $params{order_by};		# will be rebuilt below
    delete $params{o2};			# will be rebuilt below;
    delete $params{search_opt_order_by};# don't use this!
    delete $params{page};		# reset to first page

    # Get some details of the model
    # 
    my $objects    = $r->objects;
    $model_class ||= ref( $objects->[0] ) || $objects->[0];
    $fields      ||= $model_class->list_columns;

    # Make a URI with the path (just needs the query args to complete it
    # 
    my $action_uri = $r->make_action_uri;

    # Get a hash of all columns
    my %names = map { $_ => 1 } $model_class->columns;

    # Now make a list of href values for each column
    # 
    my @links;
 
    foreach my $field ( @$fields ) 
    {
        # is this a column? - it might be a has_many field instead
        if ( $names{ $field } )
        {
	    $params{order} = $field;
	    delete $params{o2};
	    $params{o2}    = $order_dir if $order_by eq $field and $order_dir;
	    my $column_uri = $action_uri->clone;
	    $column_uri->query_form(\%params);	# can't chain this call :(
            push @links, [
		$column_uri,
		$order_by eq $field ? ($order_dir eq 'desc' ? 1 : -1) : 0 ];
        }
        else # has_many, might_have fields
        {
            push @links, undef;	# no href
        }
    }
    
    return @links;
}


1;

__END__

=head1 DESCRIPTION

This package provides methods to construct URLs so they can be employed
on Maypole-generated web pages. It also provides methods to parse those
URLs into table names and actions so they can be interpreted by Maypole.
This plugin replaces code that was split between the templates, template
macros and Maypole itself.

The goals of the package are:

=over

=item
to place all the related code together,
where it is easier to understand, maintain and extend;

=item
to B<not> generate HTML, deferring that to the template;

=item
to rely on a standard package for URL manipulation in order to avoid the
errors that crept into previous 'hand-rolled' implementations.

=back

The plugin uses the L<URI> package to manipulate URLs and so achieve its
third goal.

It adds a new attribute to Maypole::Config for its own use.
C<<Maypole->config->base_uri_obj>> is a URI object representing the same
URL as the existing string-valued attribute C<<Maypole->config->uri_base>>.
You should not need to be aware of this new attribute unless you wish to
modify this plugin.


=head1 METHODS

=head2 setup

C<setup> is the Maypole::Model equivalent of a module's import method.
We intercept it as a convenient way to do our initialization, since
Maypole provides no standard way for plugins to initialize themselves.
You don't need to call this method yourself, it will be called
automatically when you call the model's setup to make your database
connection.
See L<Maypole::Manual::Plugins> if you'd like more understanding.


=head2 parse_path

This method replaces the method of the same name in the Maypole package.
It provides the same functionality but uses L<URI> to do so.
It is called automatically within C<Maypole::handler>.

This is the inverse function to the other methods n this package that
create URLs. If you want to use some different URL design, you need to
change the other methods to create the URLs you want, and change this
method to recognize your new design.


=head2 make_action_uri

This method constructs a URI object to represent a specific action on a
particular model subclass.

  my $uri = $r->make_action_uri;

or perhaps

  my $uri = $r->make_action_uri($object->id);

The table name and action are extracted from the corresponding attributes
of the Maypole request object. You can supply additional components of the
path as a string argument. This might typically be used for a record's
primary key, as in the example. Do B<not> try to add query arguments in
this way, use the methods provided by L<URI> instead (e.g. C<query_form>).

=head2 make_uri

This method constructs a URI object when given the table and action etc
as arguments:

  my $uri = $r->make_uri('table', 'action');

or in a template:

  [% uri = request.make_uri('table', 'action') %]

or

  <a href="[% request.make_uri('frontpage') %]">
    [%- config.application_name -%]
  </a>

The list of arguments are used as segment names in the path.
It can also be passed query arguments, as a hashref at the end:

  my $uri = $r->make_uri('table', 'some_query_action', { key => value });

or in a template

  [% uri = request.make_uri('table', 'some_query_action', key = value) %]

The URI object will automatically be interpolated as a string just by
using it in the template, perhaps like this:

  <a href="[% uri %]" class="important">My Label</a>


=head2 make_header_links

This method makes URLs for clickable column headers to control sorting.
It is intended for use in a template, such as F<list>.
The interface is somewhat awkward; any suggestions to improve it will be
gratefully received.

  [% links = request.make_header_links %]

By default, it returns a list with one element for each column that
would be returned by calling C<list_columns> in the current model class.

=head3 arguments

It can also accept two optional arguments:

=over

=item model class

The name of a model subclass, representing a table. This might be useful
if your template includes data from more than one class.
Note that if you want to use the default model class but do wish to
supply a list of fields, you can use zero as the value of this parameter
(Template Toolkit does not have the notion of C<undef>).

=item fields

A list of database column names and perhaps foreign key accessors.

=back

  [% links = request.make_header_links('BeerDB::Brewery') %]
  [% links = request.make_header_links('BeerDB::Brewery', name, comments) %]
  [% links = request.make_header_links(0, name, comments, beers) %]

=head3 return value

The return value is a list with an element for each column, as mentioned
above. Each element of the list is itself a reference to a list of two
items. Why? It's to do with how we build the content on the web page
(i.e. the HTML C<< <a> >> elements). This package doesn't create any HTML,
to allow the template designer to customize it with extra attributes or
text as desired. We do return a URL that can be used as the value of the
C<href> attribute of the link but that's not enough. The web page also
most likely needs to show which column is currently ordered - a little
arrow is used in the example templates. We can't generate that content
here, because it's HTML markup that should be determined by the template,
so we just return an integer that the template can use to generate
whatever glyph it wants.

So here are the details of the list reference we return for each column:

=over

=item [0]

The href that will sort the page on this column.
It will normally sort the page so this column's values appear in
ascending order, but if the page is already sorted like that, the link
will reverse the order.

=item [1]

An integer indicating the current ordering:

=over

=item 0
not currently sorted on this column;

=item -1
currently sorted on this column, in descending order;

=item 1
currently sorted on this column, in ascending order.

=back

=back

If C<make_header_links> finds that one of the fields is not a database
column name, it still outputs an element in the list, but that element
is C<undef> rather than a two-element list. Such a non-database field
name can either be passed explicitly as an argument or can be returned
by C<list_columns>. These names are sometimes used to add additional
content to a list.

Here's a skeleton example:


  <!-- custom/table_headings.tt -->
  [%# Produce the table headings

    # This produces column headings displayed at the top of lists.
    # It outputs a table heading row: <tr> <th>..</th> ... </tr>
    # Template variables used include:
    # - request - the Maypole request object
    # - tables  - the global static hash of table properties
    # - columns - the global static hash of column properties
    #
    # - table   - the name of the current table (set by list.tt)
    # - pager   - an object that responds to the Data::Page interface.
  -%]
    <tr>
  [%  query = request.query ;
    args  = {} ;
    IF query.size ;
        action = 'do_search' ;
	args.import(query) ;	# copy all params from the request
    ELSE ;
        action = 'list' ;
    END ;

    IF pager ; args.page = pager.current_page ; END ;

    header_links = request.make_header_links(0, tables.$table.list_columns) ;

    # Now make a heading for each column
    FOR col = tables.$table.list_columns.list ;
        '      <th>' ;
        label = columns.$table.$col.singular ;

	x = header_links.shift ;	# get next column
	IF x ;	# is it a real database column?
	    href = x.0 ;		# the URL for the link
	    dir  = x.1 ;		# sorting direction

            # Output the link, and include a down arrow or up arrow for
	    # the currently sorted column
	    '<a href="' ; href ; '">' ; label ; '</a>' ;

	    IF dir ==  1 ; '&darr;' ; END ;
	    IF dir == -1 ; '&uarr;' ; END ;
	ELSE ;	# this 'column' is something other than a database column
	    # Not sure this produces sensible text but I don't have any
	    # examples yet so I don't care :)
	    IF label ; label ; ELSE ; col ; END ;
	END ;

        "</th>\n" ;
    END ;
  -%]
      <th id="actionth">Actions</th>
    </tr>
  <!-- end custom/table_headings.tt -->


=head1 AUTHOR

Dave Howorth, C<< <djh@cpan.org> >>

=head1 SUPPORT

Please ask questions on the Maypole list.
Please report any bugs via CPAN.

=head1 COPYRIGHT & LICENSE

Copyright 2005 Dave Howorth, All Rights Reserved.

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

=cut