From: Matthew Horsfall (alh) Date: Sat, 30 Jul 2011 17:38:02 +0000 (-0400) Subject: Separate out App::IdiotBox::* DB objects and put create/update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FApp-IdiotBox.git;a=commitdiff_plain;h=f29e9b6f6ae3cd365017102ed4ec49160fe8f46a Separate out App::IdiotBox::* DB objects and put create/update validation logic in them. --- diff --git a/lib/App/IdiotBox.pm b/lib/App/IdiotBox.pm index a915049..119f517 100644 --- a/lib/App/IdiotBox.pm +++ b/lib/App/IdiotBox.pm @@ -7,40 +7,9 @@ use HTML::Zoom; use HTML::Zoom::FilterBuilder::Template; use List::Util qw(first); -{ - package App::IdiotBox::Announcement; - - sub id { shift->{id} } - sub made_at { shift->{made_at} } - sub bucket { shift->{bucket} } - sub video_count { shift->{video_count} } - - package App::IdiotBox::Bucket; - - sub slug { shift->{slug} } - sub name { shift->{name} } - sub video_count { - exists $_[0]->{video_count} - ? $_[0]->{video_count} - : $_[0]->{videos}->count - } - sub videos { shift->{videos} } - - package App::IdiotBox::Video; - - sub slug { shift->{slug} } - sub name { shift->{name} } - sub author { shift->{author} } - sub details { shift->{details} } - sub bucket { shift->{bucket} } - sub file_name { - (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g; - $s; - } - sub url_path { - join('/', $_[0]->bucket->slug, $_[0]->slug); - } -} +use App::IdiotBox::Announcement; +use App::IdiotBox::Bucket; +use App::IdiotBox::Video; has $_ => (is => 'ro') for qw(recent_announcements buckets); @@ -66,23 +35,19 @@ sub BUILD { sub dispatch_request { my $self = shift; sub (/) { $self->show_front_page }, + sub (/admin/) { sub (%new_name=&new_slug=) { my ($self, $name, $slug) = @_; - unless ($name && $slug) { - return $self->show_admin_page(error => "Please enter a name and a bucket"); - } - if ($name =~ /^\s+$/ || $slug =~ /^\s+$/) { - return $self->show_admin_page(error => "Names/buckets must not be all whitespace"); - } - - $slug =~ s/ /-/g; - - my $nb = $self->buckets->add(bless({ + my ($nb, $err) = App::IdiotBox::Bucket->create( slug => $slug, name => $name, - }, 'App::IdiotBox::Bucket')); + ); + + return $self->show_admin_page(error => $err) if $err; + + my $nb = $self->buckets->add($nb); $self->show_admin_page; }, @@ -93,15 +58,15 @@ sub dispatch_request { my $bucket = $self->buckets->get({ slug => $_[1] }); sub (%new_name=) { my ($self, $new_name) = @_; - if (!$new_name) { - return $self->show_edit_bucket_page($bucket, error => "Please enter a new name"); - } elsif ($new_name =~ /^\s+$/) { - return $self->show_edit_bucket_page($bucket, error => "Names must not be all whitespace"); - } - $self->buckets->replace($bucket, bless({ - slug => $bucket->slug, - name => $new_name, - }, 'App::IdiotBox::Bucket')); + + my ($ub, $err) = $bucket->update( + name => $new_name, + ); + + return $self->show_admin_page(error => $err) if $err; + + $self->buckets->replace($bucket, $ub); + $self->show_bucket_edited_page($bucket); }, sub (/) { diff --git a/lib/App/IdiotBox/Announcement.pm b/lib/App/IdiotBox/Announcement.pm new file mode 100644 index 0000000..b30d2fd --- /dev/null +++ b/lib/App/IdiotBox/Announcement.pm @@ -0,0 +1,12 @@ +package App::IdiotBox::Announcement; + +use Moo; + +sub fields { return qw(id made_at bucket_slug) } + +sub id { shift->{id} } +sub made_at { shift->{made_at} } +sub bucket { shift->{bucket} } +sub video_count { shift->{video_count} } + +1; diff --git a/lib/App/IdiotBox/Bucket.pm b/lib/App/IdiotBox/Bucket.pm new file mode 100644 index 0000000..9af2507 --- /dev/null +++ b/lib/App/IdiotBox/Bucket.pm @@ -0,0 +1,52 @@ +package App::IdiotBox::Bucket; + +use Moo; + +sub fields { return qw(slug name) } + +with 'App::IdiotBox::Clonable'; + +sub slug { shift->{slug} } +sub name { shift->{name} } +sub video_count { + exists $_[0]->{video_count} + ? $_[0]->{video_count} + : $_[0]->{videos}->count +} +sub videos { shift->{videos} } + +sub create { + my ($class, %args) = @_; + + unless ($args{name} && $args{slug}) { + return (undef, "Please enter a name and a bucket"); + } + if ($args{name} =~ /^\s+$/ || $args{slug} =~ /^\s+$/) { + return (undef, "Names/buckets must not be all whitespace"); + } + + $args{slug} =~ s/\s+/-/g; + + return bless { + name => $args{name}, + slug => $args{slug}, + }, $class; +} + +sub update { + my ($self, %args) = @_; + + unless ($args{name}) { + return (undef, "Please enter a new name"); + } + + if ($args{name} =~ /^\s+$/) { + return (undef, "Names must not be all whitespace"); + } + + $self->{name} = $args{name}; + + $self->clone; +} + +1; diff --git a/lib/App/IdiotBox/Clonable.pm b/lib/App/IdiotBox/Clonable.pm new file mode 100644 index 0000000..3852caf --- /dev/null +++ b/lib/App/IdiotBox/Clonable.pm @@ -0,0 +1,19 @@ +package App::IdiotBox::Clonable; + +use Moo::Role; + +sub clone { + my $obj = shift; + + my $class = ref $obj; + + my %copy; + + for my $f ($obj->fields) { + $copy{$f} = $obj->$f, + }; + + return bless \%copy, $class; +} + +1; diff --git a/lib/App/IdiotBox/Importer.pm b/lib/App/IdiotBox/Importer.pm index 4600777..f0d0967 100644 --- a/lib/App/IdiotBox/Importer.pm +++ b/lib/App/IdiotBox/Importer.pm @@ -41,15 +41,20 @@ sub run { my $sn = prompt("What's the new short name (url path) for the slug ?"); my $ln = prompt("What's the new long name (description) for the slug ?"); - $sn =~ s/ /-/g; - - my $nb = $ib->buckets->add(bless({ + my ($nb, $err) = App::IdiotBox::Bucket->create( slug => $sn, name => $ln, - }, 'App::IdiotBox::Bucket')); + ); + + if ($err) { + log_info { "Error creating new bucket: $err" }; + redo CHOOSE; + } + + my $rnb = $ib->buckets->add($nb); log_info { "Created new bucket" }; - push @buckets, $nb; + push @buckets, $rnb; redo BUCKETS; } diff --git a/lib/App/IdiotBox/Video.pm b/lib/App/IdiotBox/Video.pm new file mode 100644 index 0000000..99b7c38 --- /dev/null +++ b/lib/App/IdiotBox/Video.pm @@ -0,0 +1,20 @@ +package App::IdiotBox::Video; + +use Moo; + +sub fields { return qw(slug bucket_slug name author details announcement_id) } + +sub slug { shift->{slug} } +sub name { shift->{name} } +sub author { shift->{author} } +sub details { shift->{details} } +sub bucket { shift->{bucket} } +sub file_name { + (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g; + $s; +} +sub url_path { + join('/', $_[0]->bucket->slug, $_[0]->slug); +} + +1;