forward porting fixUrl bugfix and test

docs/changelog/7.x.x.txt

@@ -12,6 +12,8 @@
 7.4.18
  - fix: Auto Request Commit setting creates extra version tag if asset uses
    requestAutoCommit
+ - fix: Some urls cause an asset to be inaccessible after creation/editing (perlDreamer Consulting, LLC.)
+     http://www.plainblack.com/bugs/tracker/some-urls-cause-an-asset-to-be-inaccessible-after-creation/editing
 
 7.4.17
  - fix: double width characters encoded incorrectly in Collaboration RSS feed

lib/WebGUI/Asset.pm

@@ -564,7 +564,7 @@ sub fixUrl {
 
 	# urls can't be longer than 250 characters
 	if (length($url) > 250) {
-		$url = substr($url,220);
+		$url = substr($url,0,220);
 	}
 
 	# remove multiple extensions from the url if there are some

t/Asset/Asset.t

@@ -17,7 +17,7 @@ use WebGUI::Session;
 use WebGUI::Asset;
 use WebGUI::Asset::Wobject::Navigation;
 
-use Test::More tests => 31; # increment this value for each test you create
+use Test::More tests => 32; # increment this value for each test you create
 use Test::MockObject;
 
 my $session = WebGUI::Test->session;
@@ -140,3 +140,11 @@ $session->{_request} = $newRequest;
 $func = 'add';
 is($importNode->addEditLabel, $i18n->get('add').' '.$importNode->getName, 'addEditLabel, use add mode');
 $session->{_request} = $origRequest;
+
+################################################################
+#
+# fixUrl
+#
+################################################################
+
+is($importNode->fixUrl('1234'.'-'x250 . 'abcdefghijkl'), '1234'.'-'x216, 'fixUrl truncates to 220 characters');

t/lib/Perl/Critic/Policy/WebGUI/NoIllegalI18NLabels.pm

@@ -63,7 +63,8 @@ sub violates {
     my ($self, $elem, undef) = @_;
     ##$elem has stringification overloaded by default.
     return unless $elem eq 'new'
-               or $elem eq 'get';
+               or $elem eq 'get'
+               or $elem eq 'setNamespace';
     return if !is_method_call($elem);
     if ($elem eq 'new') {  ##Object creation,  check for class.
         my $operator = $elem->sprevious_sibling     or return;
@@ -94,6 +95,9 @@ sub violates {
         if ($arguments[1]) {
             $namespace = $arguments[1]->[0]->string;
         }
+#        print "object    : $symbol_name\n";
+#        print "label     : $label\n";
+#        print "namespace : $namespace\n";
         if (! $self->{i18n}->get($label, $namespace)) {
             return $self->violation(
                 $DESC,
@@ -103,6 +107,18 @@ sub violates {
         }
         return;
     }
+    elsif ($elem eq 'setNamespace') {  ##Set the object's default namespace
+        my $symbol_name = _get_symbol_name($elem);
+        return unless $symbol_name && exists $self->{_i18n_objects}->{$symbol_name};
+        my $arg_list = $elem->snext_sibling;
+        return unless ref $arg_list eq 'PPI::Structure::List'; 
+        my @arguments = _get_args($arg_list);
+        ##Many assumptions being made here
+        return unless $arguments[0]->[0]->isa('PPI::Token::Quote');
+        my $new_namespace = $arguments[0]->[0]->string;
+        $self->{_i18n_objects}->{$symbol_name} = $new_namespace;
+        return;
+    }
     return;
 }