Skip to content
Browse files

Initial commit

  • Loading branch information...
0 parents commit 1c830c9ebec73c475a22cd026b6f1aa3085bd909 John Beppu committed
Showing with 474 additions and 0 deletions.
  1. +8 −0 MANIFEST
  2. +8 −0 MANIFEST.SKIP
  3. +23 −0 Makefile.PL
  4. +90 −0 bin/squatting
  5. +35 −0 bugs.yaml
  6. +237 −0 lib/Squatting.pm
  7. +60 −0 lib/Squatting/Controller.pm
  8. +13 −0 lib/Squatting/Mapper.pm
8 MANIFEST
@@ -0,0 +1,8 @@
+bin/squatting
+bugs.yaml
+lib/Squatting.pm
+lib/Squatting/Controller.pm
+lib/Squatting/Mapper.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
8 MANIFEST.SKIP
@@ -0,0 +1,8 @@
+\bCVS\b
+^MANIFEST\.bak$
+^Makefile$
+\..*\.swp$
+pm_to_blib
+~$
+\bblib\b
+\b\.xvpics\b
23 Makefile.PL
@@ -0,0 +1,23 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile (
+ 'NAME' => 'Squatting',
+ 'AUTHOR' => 'John Beppu <beppu@cpan.org>',
+ 'VERSION_FROM' => 'lib/Squatting.pm',
+ 'ABSTRACT_FROM' => 'lib/Squatting.pm',
+ 'PREREQ_PM' => {
+ 'HTTP::Daemon' => 0,
+ },
+);
+
+sub MY::libscan {
+ my $self = shift;
+ $_ = shift;
+
+ # $self appears to be a blessed hashref that contains
+ # all the attributes/value pairs passed to WriteMakeFile()
+ # plus some other MakeMaker-related info.
+
+ return 0 if /\.sw.$/ || /~$/;
+ return $_;
+}
90 bin/squatting
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Squatting;
+use Getopt::Long;
+use Data::Dump qw(dump);
+
+# defaults
+$_{port} = 4234;
+
+# command line options
+GetOptions(
+ \%_,
+ 'host|h=s',
+ 'port|p=i',
+ 'log|l=s',
+ 'console|C',
+ 'help',
+ 'version|v',
+);
+
+if ($_{version}) {
+
+} elsif ($_{help}) {
+
+} elsif ($_{log}) {
+
+} elsif ($_{console}) {
+
+} else {
+
+}
+
+print dump(\%_), "\n", dump(\@ARGV), "\n";
+
+exit 0;
+
+__END__
+
+=head1 NAME
+
+squatting -- start up a Squatting server
+
+=head1 SYNOPSIS
+
+Usage
+
+ squatting [OPTION]... APPLICATION
+
+Example: Starting Bavl on port 4234
+
+ squatting -p 4234 Bavl
+
+=head1 DESCRIPTION
+
+We're here to stay.
+
+=head1 OPTIONS
+
+=over 2
+
+=item -h, --host HOSTNAME
+
+TODO - Host for web server to bind to (default is all IPs)
+
+=item -p, --port NUM
+
+TODO - Port for web server (defaults to 4234)
+
+=item -l, --log FILE
+
+TODO - Start a log file ('-' for STDOUT)
+
+=item -C, --console
+
+TODO - Run in console mode with pirl
+
+=item -?, --help
+
+TODO - Show the help message
+
+=item -v, --version
+
+TODO - Show version
+
+=back
+
+=cut
35 bugs.yaml
@@ -0,0 +1,35 @@
+--- !ditz.rubyforge.org,2008-03-06/project
+name: Squatting
+version: 0.1.1
+issues:
+- !ditz.rubyforge.org,2008-03-06/issue
+ title: Implement the D() function for dispatching.
+ desc: D() should take an HTTP::Request as an argument and return a ($controller, $method) pair.
+ type: :feature
+ component: Squatting
+ release: "0.10"
+ reporter: John Beppu <john.beppu@gmail.com>
+ status: :unstarted
+ disposition:
+ creation_time: 2008-04-23 11:55:54.310613 -07:00
+ references: []
+
+ id: 4c4cd01cef06f5da620bcc5a31d9aa2e5cd8b4e2
+ log_events:
+ - - 2008-04-23 11:55:58.482346 -07:00
+ - John Beppu <beppu@localhost>
+ - created
+ - ""
+components:
+- !ditz.rubyforge.org,2008-03-06/component
+ name: Squatting
+releases:
+- !ditz.rubyforge.org,2008-03-06/release
+ name: "0.10"
+ status: :unreleased
+ release_time:
+ log_events:
+ - - 2008-04-23 11:53:38.160024 -07:00
+ - John Beppu <beppu@localhost>
+ - created
+ - The goal of the first release is to be able to get the HTTP server up and running.
237 lib/Squatting.pm
@@ -0,0 +1,237 @@
+package Squatting;
+
+use strict;
+use warnings;
+use base 'Exporter';
+use Continuity;
+use CGI::Simple;
+use CGI::Simple::Cookie;
+use Data::Dump qw(dump);
+
+our $VERSION = '0.01';
+our @EXPORT_OK = qw(
+ C $cr %cookies cookies %input %headers $status $s R redirect render
+);
+our %EXPORT_TAGS = (
+ controllers => [qw(C $cr %cookies cookies %input %headers $status $s R redirect render)],
+ views => [qw(%cookies %input $s R)]
+);
+
+require Squatting::Controller;
+
+our $app;
+our $cr;
+our %cookies; #incoming
+our $cookies; #outgoing
+our %input;
+our %headers;
+our $status;
+our $s;
+
+# controller constructing function
+sub C {
+ no strict 'refs';
+ my $c = shift;
+ my $controller = ref($c) ? $c : Squatting::Controller->new($c, @_);
+ $controller;
+}
+
+# stubs
+sub D { }
+sub R { warn 'No!' }
+
+# $content = render($template, $view)
+sub render {
+ "<h2>@_</h2>"
+}
+
+# redirect($url, $status_code)
+sub redirect {
+ my ($l, $s) = @_;
+ $headers{Location} = $l || '/';
+ $status = $s || 302;
+}
+
+# %ENV = env($http_request) # Extract data from HTTP::Request.
+sub env {
+ my $r = shift;
+ my %env;
+ my $uri = $r->uri;
+ $env{QUERY_STRING} = $uri->query;
+ $env{REQUEST_PATH} = $uri->path;
+ $env{REQUEST_METHOD} = $r->method;
+ $r->scan(sub {
+ my ($header, $value) = @_;
+ my $key = uc $header;
+ $key =~ s/-/_/g;
+ $key = "HTTP_$key";
+ $env{$key} = $value;
+ });
+ %env;
+}
+
+# %input = input($cr) # Extract CGI parameters for Continuity::Request.
+sub input {
+ $_[0]->params;
+}
+
+# cookies($name) = { -value => 'chocolate' } # Set outgoing cookies.
+sub cookies : lvalue {
+ $cookies->{$_[0]};
+}
+
+# Override this method if you want to take actions before or after a request is handled.
+sub service {
+ my ($class, $controller, @params) = @_;
+ my $method = lc $ENV{REQUEST_METHOD};
+ my $content;
+ {
+ no strict 'refs';
+ no warnings;
+ *render = sub { "fuck you, <h2>@_</h2>" };
+ $content = $controller->$method(@params);
+ }
+ warn "@{[$controller->name]}->$method => $content\n";
+ $headers{'Set-Cookie'} = join("; ", map {
+ CGI::Simple::Cookie->new(-name => $_, %{$cookies->{$_}})
+ } keys %$cookies) if (%$cookies);
+ return $content;
+}
+
+# Start the server.
+sub go {
+ no strict 'refs';
+ no warnings;
+
+ my $class = shift;
+ my $models = $class . "::Models";
+ my $controllers = $class . "::Controllers";
+ my $views = $class . "::Views";
+
+ $models->create if ($models->can('create'));
+ $controllers->init if ($controllers->can('init'));
+ $views->init if ($views->can('init'));
+
+ # ($controller, \@regex_captures) = D($path)
+ local *D = sub {
+ my $path = shift;
+ my $C = \@{$controllers.'::C'};
+ my ($controller, @regex_captures);
+ foreach $controller (@$C) {
+ foreach (@{$controller->urls}) {
+ if (@regex_captures = ($path =~ qr{^$_$})) {
+ return ($controller, \@regex_captures);
+ }
+ }
+ }
+ ($Squatting::Controller::r404, []);
+ };
+
+ # $url = R(Controller, params..., { cgi => vars })
+ local *R = sub {
+ warn "Yes!!!";
+ };
+
+ # Putting a RESTful face on Continuity since 2008.
+ Continuity->new(
+ port => 4234,
+ callback => sub {
+ $cr = shift;
+ local %headers;
+ local %cookies;
+ local $cookies = {};
+ local %ENV = env($cr->http_request);
+ my ($c, $p) = D($ENV{REQUEST_PATH});
+ %input = input($cr);
+ $status = 200;
+ my $content = $class->service($c, @$p);
+ my $response = HTTP::Response->new($status, '', [%headers], $content);
+ $cr->conn->send_response($response);
+ $cr->end_request;
+ },
+ @_
+ )->loop;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Squatting - a web microframework for Perl that was inspired by Camping
+
+=head1 SYNOPSIS
+
+ {
+ package Bavl;
+ use base 'Squatting';
+ sub authenticate { 1 }
+ Bavl->go();
+ }
+
+ {
+ package Bavl::Controllers;
+ use Squatting ':controllers';
+
+ C(
+ 'Home',
+ urls => [ '/' ],
+ get => sub {
+ $s->{title} = loc('Hello, World!');
+ render 'home'
+ },
+ );
+
+ C(
+ 'Login',
+ urls => [ '/log/(in|out)' ],
+ get => sub {
+ my $in_or_out = shift;
+ render 'login'
+ },
+ post => sub {
+ my $in_or_out = shift;
+ my $username = $input->{username};
+ my $password = $input->{password};
+ if (Bavl->authenticate($username, $password)) {
+ $s->{logged_in} = 1;
+ redirect R('Home');
+ } else {
+ redirect R('Login');
+ }
+ }
+ );
+ }
+
+ {
+ package Bavl::Views;
+ use Squatting ':view';
+
+ V(
+ 'HTML',
+ home => sub { "<h1>" . $s->{title} . "</h1>" },
+ login => sub { },
+ search => sub { }
+ );
+
+ V(
+ 'JSON',
+ search => sub { to_json($s) },
+ )
+ }
+
+
+=head1 DESCRIPTION
+
+This is beppu's attempt to bring the conciseness of Camping to Perl.
+
+This is also my attempt to show that you don't need to have a huge proliferation
+of classes to keep code well-organized. (JavaScript and prototype-based OO has taught
+me this.)
+
+=head1 AUTHOR
+
+John BEPPU (beppu at cpan.org)
+
+=cut
60 lib/Squatting/Controller.pm
@@ -0,0 +1,60 @@
+package Squatting::Controller;
+
+use strict;
+use warnings;
+
+use Squatting ':controllers';
+
+# constructor
+sub new {
+ my $class = shift;
+ my $name = shift;
+ bless({ name => $name, urls => [], @_ } => $class);
+}
+
+# arrayref of URL patterns that this controller responds to
+sub urls {
+ if (@_ > 1) {
+ $_[0]->{urls} = $_[1]
+ } else {
+ $_[0]->{urls}
+ }
+}
+
+# name of controller
+sub name {
+ exists $_[1] ? $_[0]->{name} = $_[1] : $_[0]->{name};
+}
+
+# method for handling HTTP GET requests
+sub get {
+ my $self = shift;
+ $self->{get}->($self, @_);
+}
+
+# method for handling HTTP POST requests
+sub post {
+ my $self = shift;
+ $self->{post}->($self, @_);
+}
+
+# default 404 controller
+our $r404 = Squatting::Controller->new(
+ 'R404',
+ get => sub {
+ "$ENV{REQUEST_PATH} not found.";
+ },
+ post => sub {
+ "$ENV{REQUEST_PATH} not found.";
+ }
+);
+
+1;
+
+__END__
+
+=head1 NAME
+
+Squatting::Controller - default controller class for Squatting
+
+=cut
13 lib/Squatting/Mapper.pm
@@ -0,0 +1,13 @@
+package Squatting::Mapper;
+
+use strict;
+use warnings;
+use base 'Continuity::Mapper';
+use Squatting;
+
+sub get_session_id_from_hit {
+ my ($self, $request) = @_;
+ my $session_id = $self->SUPER::get_session_id_from_hit($request);
+}
+
+1;

0 comments on commit 1c830c9

Please sign in to comment.
Something went wrong with that request. Please try again.