view release on metacpan or  search on metacpan

lib/Squatting.pm  view on Meta::CPAN

package Squatting;

use strict;
no  strict 'refs';
#use warnings;
#no  warnings 'redefine';
use base 'Class::C3::Componentised';

use List::Util qw(first);
use URI::Escape;
use Carp;
use Data::Dump 'pp';

our $VERSION = '0.83';

require Squatting::Controller;
require Squatting::View;

# XXX - deprecated | use App ':controllers'
# XXX - deprecated | use App ':views'
# use App @PLUGINS
# 
# No longer have to :  use base 'Squatting';
# Simply saying     :  use Squatting;
#   will muck with the calling packages @ISA.
sub import {
  my $m = shift;
  my $p = (caller)[0];

  if ($m ne 'Squatting') {
    return $m->load_components(grep /::/, @_);
  }

  push @{$p.'::ISA'}, 'Squatting';

  # $url = R('Controller', @args, { cgi => vars })  # Generate URLs with the routing function
  *{$p."::Controllers::R"} = *{$p."::Views::R"} = *{$p."::R"} = sub {
    my ($controller, @args) = @_;
    my $input;
    if (@args && ref($args[-1]) eq 'HASH') {
      $input = pop(@args);
    }
    my $c = ${$p."::Controllers::C"}{$controller};
    croak "$controller controller not found in '\%$p\::Controllers::C" unless $c;
    my $arity = @args;
    my $path = first { my @m = /\(.*?\)/g; $arity == @m } @{$c->urls};
    croak "couldn't find a matching URL path" unless $path;
    while ($path =~ /\(.*?\)/) {
      $path =~ s{\(.*?\)}{uri_escape(+shift(@args), "^A-Za-z0-9\-_.!~*’()/")}e;
    }
    if ($input) {
      $path .= "?".  join('&' => 
        map { 
          my $k = $_;
          ref($input->{$_}) eq 'ARRAY'
            ? map { "$k=".uri_escape($_) } @{$input->{$_}}
            : "$_=".uri_escape($input->{$_})
        } keys %$input);
    }
    $path;
  };

  # ($controller, \@regex_captures) = D($path)  # Return controller and captures for a path
  *{$p."::D"} = sub {
    my $url = uri_unescape($_[0]);
    my $C = \@{$p.'::Controllers::C'};
    my ($c, @regex_captures);
    for $c (@$C) {
      for (@{$c->urls}) {
        if (@regex_captures = ($url =~ qr{^$_$})) {
          pop @regex_captures if ($#+ == 0);
          return ($c, \@regex_captures);
        }
      }
    }
    ($Squatting::Controller::r404, []);
  };

  *{$p."::Controllers::C"} = sub {
    Squatting::Controller->new(@_, app => $p)
  };
  *{$p."::Views::V"} = sub {
    Squatting::View->new(@_)
  };

}

# Squatting plugins may be anywhere in Squatting::*::* but by convention