[Catalyst-commits] r7712 - Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller

ruoso at dev.catalyst.perl.org ruoso at dev.catalyst.perl.org
Wed May 7 16:19:27 BST 2008


Author: ruoso
Date: 2008-05-07 16:19:27 +0100 (Wed, 07 May 2008)
New Revision: 7712

Modified:
   Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm
Log:
[C-C-SOAP] redefines _parse_attr to match the method as in the Controller.pm in trunk, while it is not released

Modified: Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm
===================================================================
--- Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm	2008-05-07 13:23:04 UTC (rev 7711)
+++ Catalyst-Controller-SOAP/1.0/trunk/lib/Catalyst/Controller/SOAP.pm	2008-05-07 15:19:27 UTC (rev 7712)
@@ -21,24 +21,49 @@
     sub _parse_attrs {
         my ( $self, $c, $name, @attrs ) = @_;
 
-        my @others = grep { $_ !~ /^WSDLPort/ } @attrs;
-        my $final = $self->SUPER::_parse_attrs($c, $name, @others);
+        my %raw_attributes;
 
-        my ($attr) = grep { $_ && $_ =~ /^WSDLPort/ } @attrs;
-        return $final unless $attr;
+        foreach my $attr (@attrs) {
 
-        if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
-        {
-            if ( defined $value ) {
-                ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
+            # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
+
+            if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) ) {
+
+                if ( defined $value ) {
+                    ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
+                }
+                push( @{ $raw_attributes{$key} }, $value );
             }
-            my %ret = $self->_parse_WSDLPort_attr($c, $name, $value);
-            push( @{ $final->{$_} }, $ret{$_} ) for
-              keys %ret;
         }
 
+        my $hash = (ref $self ? $self : $self->config); # hate app-is-class
 
-        return $final;
+        if (exists $hash->{actions} || exists $hash->{action}) {
+            my $a = $hash->{actions} || $hash->{action};
+            %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()),
+                               %raw_attributes,
+                               (exists $a->{$name} ? %{$a->{$name}} : ()));
+        }
+
+        my %final_attributes;
+
+        foreach my $key (keys %raw_attributes) {
+
+            my $raw = $raw_attributes{$key};
+
+            foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
+
+                my $meth = "_parse_${key}_attr";
+                my %new_attributes;
+                if ( $self->can($meth) ) {
+                    %new_attributes = $self->$meth( $c, $name, $value );
+                }
+                push( @{ $final_attributes{$_} }, $new_attributes{$_} )
+                  for keys %new_attributes;
+            }
+        }
+
+        return \%final_attributes;
     }
 
 




More information about the Catalyst-commits mailing list