Permalink
Browse files

wip

  • Loading branch information...
1 parent 4cb5837 commit 07345eddc10e318f421c67300cab38336b710170 @yanick committed Feb 15, 2010
View
@@ -0,0 +1 @@
+*.sw[op]
View
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use REST::Client;
+use JSON;
+
+GetOptions(
+ 'yeah!' => \my $yeah,
+ 'neah!' => \my $neah,
+ 'meh!' => \my $meh,
+ 'instead=s' => \my $instead,
+ 'comment=s' => \my $comment,
+ 'user=s' => \my $username,
+ 'password=s' => \my $password,
+ 'register!' => \my $register,
+);
+
+
+die "user and password required\n" unless $username and $password;
+
+my $client = REST::Client->new( follow => 1, useragent => My::Agent->new );
+$client->setHost('http://localhost:3000');
+
+exit register_user() if $register;
+
+die "has to use exactly use one of --yeah, --neah or --meh"
+ if 1 != grep { defined $_ } $yeah, $neah, $meh;
+
+my $dist = shift;
+
+$dist =~ s/::/-/g;
+
+my $vote = $yeah ? 1 : $neah ? -1 : 0;
+
+
+my %data;
+
+$data{vote} = $vote;
+$data{comment} = $comment if $comment;
+$data{instead} = $instead if $instead;
+
+$client->PUT(
+ "dist/$dist/vote",
+ encode_json( \%data ),
+ { 'content-type' => 'application/json' } );
+
+print $client->responseContent;
+
+sub register_user {
+ my %data = (
+ username => $username,
+ password => $password,
+ );
+
+ $client->PUT(
+ 'register',
+ encode_json( \%data ),
+ { 'content-type' => 'application/json' } );
+
+ print $client->responseContent, "\n";
+}
+
+package My::Agent;
+
+use parent 'LWP::UserAgent';
+
+sub get_basic_credentials {
+ return ( 'yanick', 'foo' );
+}
+
+1;
+
File renamed without changes.
File renamed without changes.
View
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use 5.010;
+
+use Data::Dumper;
+use DBI;
+
+my $dbh = DBI->connect('dbi:SQLite:dbname=/home/yanick/.cpan/cpandb.sql');
+
+use cpanvote::Schema;
+
+my $schema = cpanvote::Schema->connect( 'dbi:SQLite:dbname=db.sqlite' );
+
+my $c = $dbh->prepare( 'SELECT dist_name from dists' );
+$c->execute;
+
+while ( my ( $distname ) = $c->fetchrow ) {
+ next if $schema->resultset('Distributions')->find({distname => $distname});
+
+ say "creating entry for $distname";
+ $schema->resultset('Distributions')->create({distname => $distname });
+}
View
@@ -16,6 +16,8 @@ use Catalyst qw/
-Debug
ConfigLoader
Static::Simple
+ Authentication
+ Cache
/;
extends 'Catalyst';
@@ -36,8 +38,32 @@ __PACKAGE__->config(
name => 'cpanvote',
# Disable deprecated behavior needed by old applications
disable_component_resolution_regex_fallback => 1,
+ authentication => {
+ default_realm => 'http',
+ realms => {
+ http => {
+ credential => {
+ class => 'HTTP',
+ type => 'any', # or 'digest' or 'basic'
+ password_type => 'clear',
+ password_field => 'password'
+ },
+ store => {
+ class => 'Minimal',
+ users => {
+ yanick => { password => "foo", },
+ },
+ },
+ },
+ }
+ },
);
+__PACKAGE__->config->{'Plugin::Cache'}{backend} = {
+ class => "Cache::Memory",
+};
+
+
# Start the application
__PACKAGE__->setup();
@@ -0,0 +1,145 @@
+package cpanvote::Controller::Dist;
+use Moose;
+use namespace::autoclean;
+
+BEGIN {
+ extends 'Catalyst::Controller::REST';
+}
+
+=head1 NAME
+
+cpanvote::Controller::Dist - Catalyst Controller
+
+=head1 DESCRIPTION
+
+Catalyst Controller.
+
+=head1 METHODS
+
+=cut
+
+=head2 index
+
+=cut
+
+sub base : Chained('/') : PathPart('dist') : CaptureArgs(1) {
+ my ( $self, $c, $distname ) = @_;
+
+ $c->stash->{dist} =
+ $c->model('cpanvoteDB::Distributions')
+ ->find( { distname => $distname } )
+ or $self->status_not_found( $c,
+ message => "distribution $distname not found" )
+ and $c->detach;
+}
+
+sub summary : Chained('base') : PathPart('summary') : ActionClass('REST') :
+ Args(0) {
+}
+
+sub summary_GET {
+ my ( $self, $c ) = @_;
+
+ my $dist = $c->stash->{dist};
+
+ my @points; # 0 = neah, 1 = meh, 2 = yeah
+ my @insteads;
+ my @comments;
+
+ for my $vote ( $dist->votes ) {
+ $points[ $vote->vote + 1 ]++;
+ push @insteads, $vote->instead_id;
+ push @comments, $vote->comment;
+ }
+
+ my %data;
+ $data{vote}{neah} = $points[0];
+ $data{vote}{meh} = $points[1];
+ $data{vote}{yeah} = $points[2];
+ $data{instead} =
+ [ map { $_->distname }
+ $c->model('cpanvoteDB::Distributions')
+ ->search( { id => [ grep { defined } @insteads ] } ) ];
+ $data{comments} = [ grep { defined } @comments ];
+
+ $self->status_ok( $c, entity => \%data );
+}
+
+sub detailed : Chained('base') : PathPart('detailed') : ActionClass('REST') :
+ Args(0) {
+}
+
+sub detailed_GET {
+ my ( $self, $c ) = @_;
+
+ my $dist = $c->stash->{dist};
+
+ my @data;
+ for my $vote ( $dist->votes ) {
+ my %v;
+ $v{who} = $vote->user->username;
+ my $points = $vote->vote;
+ $points = '+1' if $points == 1;
+ $v{vote} = $points;
+ $v{comment} = $vote->comment if $vote->comment;
+ $v{instead} = $vote->instead->distname if $vote->instead_id;
+ push @data, \%v;
+ }
+
+ $self->status_ok( $c, entity => \@data );
+}
+
+sub vote : Chained('base') : PathPart(vote) : ActionClass('REST') : Args(0) {
+}
+
+sub vote_PUT {
+ my ( $self, $c ) = @_;
+
+ $c->authenticate();
+
+ my %data = %{ $c->req->data };
+
+ my $instead = undef;
+ if ( $data{instead} ) {
+ $instead =
+ $c->model('cpanvoteDB::Distributions')
+ ->find( { distname => $data{instead} } )
+ or $self->status_bad_request( $c,
+ message => "distribution '$data{instead}' is not recognized" );
+ }
+
+ use Devel::Dwarn;
+
+ Dwarn %data;
+
+ my $user =
+ $c->model('cpanvoteDB::Users')
+ ->find( { username => $c->user->get('id') } );
+
+ Dwarn $c->user->get('id');
+
+ $user->update_or_create_related(
+ 'votes' => {
+ dist_id => $c->stash->{dist}->id,
+ comment => $data{comment},
+ vote => $data{vote},
+ instead_id => $instead ? $instead->id : undef,
+ } );
+
+ $self->status_accepted( $c, entity => { status => 'accepted' } );
+
+}
+
+=head1 AUTHOR
+
+Yanick Champoux,,,
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
@@ -0,0 +1,36 @@
+package cpanvote::Controller::Register;
+
+use Moose;
+use namespace::autoclean;
+
+BEGIN {
+ extends 'Catalyst::Controller::REST';
+}
+
+
+
+sub index :Chained('/') :PathPart('register') :ActionClass('REST') :Args(0){
+}
+
+sub index_PUT {
+ my ( $self, $c ) = @_;
+
+ my $username = $c->req->data->{username};
+ my $password = $c->req->data->{password};
+
+ if ( $c->model('cpanvoteDB::Users')->find({username => $username }) ) {
+ $self->status_bad_request( $c, message => "user '$username' already exist"
+ );
+ $c->detach;
+ }
+
+ $c->model('cpanvoteDB::Users')->create({
+ username => $username,
+ password => $password });
+
+ $self->status_accepted( $c, entity => { status => "user '$username' created" } );
+
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
@@ -0,0 +1,43 @@
+package cpanvote::Model::cpanvoteDB;
+
+use strict;
+use base 'Catalyst::Model::DBIC::Schema';
+
+__PACKAGE__->config(
+ schema_class => 'cpanvote::Schema',
+
+ connect_info => {
+ dsn => 'dbi:SQLite:dbname=/home/yanick/work/perl-modules/cpanvote/db.sqlite',
+ user => '',
+ password => '',
+ }
+);
+
+=head1 NAME
+
+cpanvote::Model::cpanvoteDB - Catalyst DBIC Schema Model
+
+=head1 SYNOPSIS
+
+See L<cpanvote>
+
+=head1 DESCRIPTION
+
+L<Catalyst::Model::DBIC::Schema> Model using schema L<cpanvote::Schema>
+
+=head1 GENERATED BY
+
+Catalyst::Helper::Model::DBIC::Schema - 0.4
+
+=head1 AUTHOR
+
+Yanick Champoux
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
View
@@ -7,7 +7,7 @@ use base qw/DBIx::Class::Schema::Versioned/;
our $VERSION = '0.01';
-__PACKAGE__->load_classes;
+__PACKAGE__->load_namespaces;
__PACKAGE__->upgrade_directory('/home/yanick/work/perl-modules/cpanvote/sql');
1;
@@ -1,4 +1,4 @@
-package cpanvote::Schema::Distributions;
+package cpanvote::Schema::Result::Distributions;
use strict;
use warnings;
@@ -24,6 +24,8 @@ __PACKAGE__->add_unique_constraint( unique_distname => ['distname'], );
__PACKAGE__->set_primary_key('id');
+__PACKAGE__->has_many( 'votes', 'cpanvote::Schema::Result::Votes', 'dist_id' );
+
1;
Oops, something went wrong.

0 comments on commit 07345ed

Please sign in to comment.