From 7c3ac93abdd308809a4a7b91c042e6635e3c5286 Mon Sep 17 00:00:00 2001
From: Flavio Poletti <flavio@polettix.it>
Date: Mon, 8 Sep 2008 11:14:05 +0200
Subject: [PATCH] Changed DWIM handling.

---
 Changes                     |  4 +++
 README                      |  2 +-
 lib/Net/Amazon/S3/Policy.pm | 61 +++++++++++++++++++++++----------------------
 3 files changed, 36 insertions(+), 31 deletions(-)

diff --git a/Changes b/Changes
index 1429ade..f3ff03b 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Net-Amazon-S3-Policy
 
+0.1.3
+       Added "SEE ALSO" section.
+       Made "DWIM" management more sane.
+
 0.1.2  Thu Sep  4 02:56:00 2008
        Put a requisite on JSON at least version 2.
        Better sample.
diff --git a/README b/README
index fd7d545..4d03cdb 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Net-Amazon-S3-Policy version 0.1.2
+Net-Amazon-S3-Policy version 0.1.3
 
 Net::Amazon::S3::Policy gives you an object-oriented interface to man‐
 age policies for Amazon S3 HTTP POST uploads.
diff --git a/lib/Net/Amazon/S3/Policy.pm b/lib/Net/Amazon/S3/Policy.pm
index 1e73500..3aadb51 100644
--- a/lib/Net/Amazon/S3/Policy.pm
+++ b/lib/Net/Amazon/S3/Policy.pm
@@ -63,43 +63,43 @@ sub conditions {
 {    # try to understand rules
 
    sub _prepend_dollar {
-      substr($_[0], 0, 1) eq '$' ? $_[0] : '$' . $_[0];
+      return substr($_[0], 0, 1) eq '$' ? $_[0] : '$' . $_[0];
    }
    my @DWIMs = (
-      sub {
-         return unless m{\A\s* (\S+?) \s* \*  \s*\z}mxs;
-         return starts_with(_prepend_dollar($1), '');
-      },
-      sub {
-         return unless m{\A\s* (\S+) \s+ eq \s+ (.*?) \s*\z}mxs;
-         return ($2 eq '*')
-           ? starts_with(_prepend_dollar($1), '')
-           : exact(_prepend_dollar($1), $2);
-      },
-      sub {
-         return
-           unless
-            m{\A\s* (\S+) \s+ (?: ^ | starts[_-]?with) \s+ (.*?) \s*\z}mxs;
-         return starts_with(_prepend_dollar($1), $2);
-      },
-      sub {
-         return
-           unless m{\A\s* (\d+) \s*<=\s* (\S+) \s*<=\s* (\d+) \s*\z}mxs;
-         my ($min, $value, $max) = ($1, $2, $3);
-         s{_}{}g for $min, $max;
-
-         # no "_prepend_dollar" for range conditions
-         return range($value, $min, $max);
-      },
+         qr{\A\s* (\S+?) \s* \*  \s*\z}mxs => sub {
+            my $target = _prepend_dollar(shift);
+            return starts_with($target, '');
+         },
+         qr{\A\s* (\S+) \s+ eq \s+ (.*?) \s*\z}mxs => sub{
+            my $target = _prepend_dollar(shift);
+            my $value = shift;
+            return $value eq '*' ? starts_with($target, '') : exact($target, $value);
+         },
+         qr{\A\s* (\S+) \s+ (?: ^ | starts[_-]?with) \s+ (.*?) \s*\z}mxs => sub {
+            my $target = _prepend_dollar(shift);
+            my $prefix = shift;
+            return starts_with($target, $prefix);
+         },
+         qr{\A\s* (\d+) \s*<=\s* (\S+) \s*<=\s* (\d+) \s*\z}mxs => sub {
+            my ($min, $value, $max) = @_;
+            s{_}{}g for $min, $max;
+
+            # no "_prepend_dollar" for range conditions
+            return range($value, $min, $max);
+         },
    );
 
    sub _resolve_rule {
-      local $_ = shift;
-      for my $tester (@DWIMs) {
-         if (my $retval = $tester->()) {
-            return $retval;
+      my ($string) = @_;
+
+      for my $i (0 .. (@DWIMs - 1) / 2) {
+         my ($regex, $callback) = @DWIMs[$i * 2, $i * 2 + 1];
+         if (my @captures = $string =~ /$regex/) {
+            my $result = $callback->(@captures);
+            return $result if defined $result;
          }
       }
+
       croak "could not understand '$_', bailing out";
    } ## end sub _resolve_rule
 }
@@ -108,6 +108,7 @@ sub add {
    my ($self, $condition) = @_;
    push @{$self->conditions()},
      ref($condition) ? $condition : _resolve_rule($condition);
+   return;
 }
 
 sub remove {
-- 
2.11.4.GIT