Permalink
Browse files

lib/squatting.pl is the obfuscated and golfed sub-4K expression of Sq…

…uatting
  • Loading branch information...
1 parent 20c4f01 commit f51dcc56feb4ddcbeb994f43caee428fb408cc16 @beppu committed Dec 10, 2008
Showing with 69 additions and 0 deletions.
  1. +1 −0 MANIFEST
  2. +68 −0 lib/squatting.pl
View
@@ -17,6 +17,7 @@ eg/OpenID/Provider.pm
eg/PODServer.pm
eg/README
eg/UniCodePoints.pm
+lib/squatting.pl
lib/Squatting.pm
lib/Squatting/Controller.pm
lib/Squatting/Cookbook.pod
View
@@ -0,0 +1,68 @@
+package Squatting::Controller;
+sub new{bless{name=>$_[1],urls=>$_[2],@_[3..$#_]}=>$_[0]}
+sub clone{bless{%{$_[0]},@_[1..$#_]}=> ref($_[0])}
+for my$m qw(name urls cr env input cookies state v status headers log view app){
+*{$m}=sub:lvalue{$_[0]->{$m}}}
+for my$m qw(get post head put delete options trace connect){
+*{$m}=sub{$_[0]->{$m}->(@_)}}sub param{my($self,$k,@v)=@_;
+if(defined $k){if(@v){$self->input->{$k}=((@v>1)?\@v:$v[0]);
+}else{$self->input->{$k}}
+}else{keys%{$self->input}}}
+sub render{my($self,$template,$vn)=@_;my$view;$vn||=$self->view;
+my $app=$self->app;if(defined($vn)){$view=${$app."::Views::V"}{$vn};
+}else{$view=${$app."::Views::V"}[0]}
+$view->headers=$self->headers;$view->$template($self->v)}
+sub redirect{my($self,$l,$s)=@_;$self->headers->{Location}=$l||'/';
+$self->status=$s||302}my $not_found=sub{$_[0]->status=404;
+$_[0]->env->{REQUEST_PATH}." not found."};
+our $r404=Squatting::Controller->new(R404=>[],
+get=>$not_found,post=>$not_found,app=>'Squatting');
+package Squatting;
+use base"Class::C3::Componentised";use List::Util"first";use URI::Escape;
+use Carp;our$VERSION='0.60';sub import{my $m=shift;my $p=(caller)[0];my $app=$p;
+$app=~s/::Controllers$//;$app=~s/::Views$//;if(UNIVERSAL::isa($app,'Squatting')
+){*{$p."::R"}=sub{my($controller,@args)=@_;my$input;if(@args && ref($args[-1])
+eq'HASH'){$input=pop(@args)}my$c=${$app."::Controllers::C"}{$controller};
+croak"$controller controller not found"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};
+*{$app."::D"}=sub{;my$url=uri_unescape($_[0]);
+my$C=\@{$app.'::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,[])}unless exists ${$app."::"}{D}}
+my@c;for(@_){if($_ eq':controllers'){*{$p."::C"}=sub{
+Squatting::Controller->new(@_,app=>$app)};
+}elsif($_ eq':views'){*{$p."::V"}=sub{Squatting::View->new(@_)};
+}elsif(/::/){push @c,$_}}$m->load_components(@c)if@c}
+sub component_base_class{__PACKAGE__}sub mount{my($app,$other,$prefix)=@_;
+push @{$app."::O"},$other;push @{$app."::Controllers::C"},map{
+my $urls=$_->urls;$_->urls=[ map{$prefix.$_}@$urls ];$_;
+}@{$other."::Controllers::C"}}
+sub relocate{my($app,$prefix)=@_;for(@{$app."::Controllers::C"}){
+my$urls=$_->urls;$_->urls=[ map{$prefix.$_}@$urls ]}}
+sub init{$_->init for(@{$_[0]."::O"});%{$_[0]."::Controllers::C"}=
+map{$_->name=>$_}@{$_[0]."::Controllers::C"};
+%{$_[0]."::Views::V"}=map{$_->name=>$_}@{$_[0]."::Views::V"}}
+sub service{my($app,$c,@args)=grep{defined}@_;my$method=lc
+$c->env->{REQUEST_METHOD};my$content;eval{$content=$c->$method(@args)};
+warn"EXCEPTION: $@"if($@);my$cookies=$c->cookies;$c->headers->{'Set-Cookie'}=
+join("; ",map{CGI::Cookie->new(-name=>$_,%{$cookies->{$_}})}
+grep{ref$cookies->{$_}eq'HASH'}keys %$cookies)if(%$cookies);$content}
+package Squatting::View;sub new{
+my$class=shift;my$name=shift;bless{name=>$name,@_}=>$class}
+sub name:lvalue{$_[0]->{name}};sub headers:lvalue{$_[0]->{headers}}
+sub _render{my($self,$template,$vars,$alt)=@_;$self->{template}=$template;
+if(exists $self->{layout}&&($template!~/^_/)){$template=$alt if defined $alt;
+$self->{layout}($self,$vars,$self->{$template}($self,$vars));
+}else{$template=$alt if defined $alt;$self->{$template}($self,$vars)}}
+sub AUTOLOAD{my($self,$vars)=@_;my$template=$AUTOLOAD;
+$template=~s/.*://;if(exists $self->{$template}&&ref($self->{$template})eq
+'CODE'){$self->_render($template,$vars)}elsif(exists$self->{_}){
+$self->_render($template,$vars,'_')}else{die(
+"$template cannot be rendered.")}};sub DESTROY{};1;

0 comments on commit f51dcc5

Please sign in to comment.