[Jifty-commit] r5398 - in Net-Jifty: .

[Jifty commits]

Author: sartak
Date: Wed May  7 20:28:53 2008
New Revision: 5398

Modified:
   Net-Jifty/   (props changed)
   Net-Jifty/lib/Net/Jifty.pm

Log:
 r55325 at onn:  sartak | 2008-05-07 20:28:45 -0400
 Net::Jifty->create_model_class which works surprisingly well for a first pass


Modified: Net-Jifty/lib/Net/Jifty.pm
==============================================================================
--- Net-Jifty/lib/Net/Jifty.pm	(original)
+++ Net-Jifty/lib/Net/Jifty.pm	Wed May  7 20:28:53 2008
@@ -1,6 +1,7 @@
 #!/usr/bin/env perl
 package Net::Jifty;
 use Moose;
+use Net::Jifty::Record;
 
 use LWP::UserAgent;
 use HTTP::Request;
@@ -938,6 +939,80 @@
     return $user->{email};
 }
 
+=head2 create_model_class Name[, ClassName] -> ClassName
+
+Creates a new model class for the given Name. You may pass in a ClassName if
+you already have a subclass of L<Net::Jifty::Record>.
+
+=cut
+
+sub create_model_class {
+    my $self  = shift;
+    my $model = shift;
+    my $class = shift;
+
+    # retrieve and massage spec from the server..
+    my $spec = $self->get_model_spec($model);
+    my @attributes = $self->_moosify_columns($spec);
+
+    my ($last) = $model =~ /.*::(.*)/;
+    if (!$class) {
+        if (blessed($self) eq 'Net::Jifty') {
+            $class = "Net::Jifty::Record::$last";
+        }
+        else {
+            $class = blessed($self) . "::$last";
+        }
+    }
+
+    my $meta = Class::MOP::Class->create(
+        $class,
+        superclasses => ['Net::Jifty::Record'],
+        attributes   => \@attributes,
+    );
+
+    return $meta->name;
+}
+
+sub _moosify_columns {
+    my $self = shift;
+    my $model_spec = shift;
+    my @attributes;
+
+    for my $column (keys %$model_spec) {
+        next if $column eq 'id'; # already taken care of
+        my $spec = $model_spec->{$column};
+        my %opts;
+
+        $opts{is} = $spec->{readable} && $spec->{writable} ? 'rw'
+                  : $spec->{readable}                      ? 'ro'
+                  : undef;
+        $opts{isa} = $self->_moosify_type($spec->{type});
+
+        push @attributes, Moose::Meta::Attribute->new($column, %opts);
+    }
+
+    return @attributes;
+}
+
+my %types = (
+    serial => 'Int',
+);
+
+sub _moosify_type {
+    my $self = shift;
+    my $type = lc(shift);
+
+    return $types{$type} if exists $types{$type};
+
+    return 'Int'  if $type =~ /int/;
+    return 'Str'  if $type =~ /char|text/;
+    return 'Num'  if $type =~ /numeric|decimal|real|double|float/;
+    return 'Bool' if $type =~ /bool/;
+
+    return undef;
+}
+
 =head1 SEE ALSO
 
 L<Jifty>, L<Net::Hiveminder>