Minor fixes to make updating actually work.

[catagits/App-IdiotBox.git] / lib / App / IdiotBox / Video.pm

diff --git a/lib/App/IdiotBox/Video.pm b/lib/App/IdiotBox/Video.pm
index 99b7c38..e02fd89 100644 (file)
--- a/lib/App/IdiotBox/Video.pm
+++ b/lib/App/IdiotBox/Video.pm
@@ -4,6 +4,10 @@ use Moo;
 
 sub fields { return qw(slug bucket_slug name author details announcement_id) }
 
+with 'App::IdiotBox::Clonable';
+
+sub announcement_id { shift->{announcement_id} }
+sub bucket_slug { shift->{bucket_slug} }
 sub slug { shift->{slug} }
 sub name { shift->{name} }
 sub author { shift->{author} }
@@ -17,4 +21,38 @@ sub url_path {
   join('/', $_[0]->bucket->slug, $_[0]->slug);
 }
 
+sub update {
+       my ($self, %args) = @_;
+
+       my %update = map { $_ => delete $args{$_} } grep { exists $args{$_} } $self->fields;
+
+       if (%args) {
+               return (undef, "Unknown fields in update: " . join(',', keys %args));
+       }
+
+       unless (%update) {
+               return (undef, "No changes requested");
+       }
+
+       for my $k (qw(slug bucket_slug name author details)) {
+               my @bad;
+
+               if (exists $update{$k} && $update{$k} =~ /^\s+$/) {
+                       push @bad, $k;
+               }
+
+               return (undef, "Empty fields in update: ", join(',', @bad)) if @bad;
+       }
+
+       for my $k (qw(slug bucket_slug)) {
+               $update{$k} =~ s/\s+/-/g if exists $update{$k};
+       }
+
+       my $new = $self->clone;
+
+       $new->{$_} = $update{$_} for keys %update;
+
+       return $new;
+}
+
 1;