[interchange] Add set_source SpecialSub.

[Peter Ajamian]

commit 5f1acc784e2247bb43c64e7ceff1154a04f5b31b
Author: Peter Ajamian <peter at pajamian.dhs.org>
Date:   Tue Mar 17 18:42:46 2015 +1300

    Add set_source SpecialSub.
    
    This commit adds the set_source SpecialSub which is called when the affiliate
    source is about to be set or changed.  The sub is called with three args:
    
        source - This is the new affiliate source that is about to be set.
        priority - This is the priority (as per the SourcePriority configuration
    	directive) that this source change falls under.
        oldsource - This is the affiliate source that was already set and is about
    	to be overwritten.
    
    Return values:  Any defined value returned by this sub becomes the new affiliate
    source.  If undef is returned then the old source is kept and processing
    continues onto the next priority in the SourcePriority list.
    
    Example usage:  The following example usage will make sure that a customer who
    enters your site with an affiliate source does not do so from a search engine
    link:
    
    Sub <<EOS
    sub source_check_referer {
        my ($source, $priority) = @_;
        return $source unless $priority eq 'mv_pc' || $priority eq 'mv_source';
        my $referer = $Tag->env('HTTP_REFERER');
    
        my @bad_referers = qw{
            www.google
            www.bing.com
            search.yahoo.com
            www.dnsrsearch.com
            thesmartsearch.net
            yandex.ru
            duckduckgo.com
            www.searchassist.net
            baidu.com
        };
    
        for (@bad_referers) {
            return if $referer =~ /\Q$_\E/;
        }
    
        return $source;
    }
    EOS
    SpecialSub set_source source_check_referer

 lib/Vend/Dispatch.pm |   34 ++++++++++++++++++++++++++++------
 1 files changed, 28 insertions(+), 6 deletions(-)
---
diff --git a/lib/Vend/Dispatch.pm b/lib/Vend/Dispatch.pm
index dba59ba..a2453ce 100644
--- a/lib/Vend/Dispatch.pm
+++ b/lib/Vend/Dispatch.pm
@@ -1238,6 +1238,31 @@ sub run_macro {
 	}
 }
 
+sub set_source {
+    my ($source, $priority) = @_;
+    my ($subname, $sub);
+    if ($subname = $Vend::Cfg->{SpecialSub}{set_source} and
+	$sub = $Vend::Cfg->{Sub}{$subname} || $Global::GlobalSub->{$subname}) {
+	my $ret;
+	eval { $ret = $sub->($source, $priority, $Vend::Session->{source}) };
+
+	if($@) {
+	    ::logError("Error running %s subroutine %s: %s",
+		       'set_source', $subname, $@);
+	    return;
+	}
+
+	if (defined $ret) {
+	    $Vend::Session->{source} = $ret;
+	}
+
+	return $ret;
+    }
+
+    $Vend::Session->{source} = $source;
+    return $source;
+}
+
 sub dispatch {
 	my($http) = @_;
 	$H = $http;
@@ -1499,8 +1524,7 @@ EOF
             if ($CGI::values{mv_pc} and $CGI::values{mv_pc} =~ /\D/) {
                 $new_source = $CGI::values{mv_pc};
 		$new_source =~ s/[\r\n\t]//g;
-		$Vend::Session->{source} = $new_source;
-                last SOURCEPRIORITY;
+		last SOURCEPRIORITY if defined set_source($new_source, $_);
             }
          }
 
@@ -1509,8 +1533,7 @@ EOF
 #::logDebug("Cookie $1 is $cookie_source");
              if (length $cookie_source) {
 		 $cookie_source =~ s/[\r\n\t]//g;
-                 $Vend::Session->{source} = $cookie_source;
-                 last SOURCEPRIORITY;
+                 last SOURCEPRIORITY if defined set_source($cookie_source, $_);
             }
          }
 
@@ -1533,8 +1556,7 @@ EOF
             if (length $CGI::values{$_}) {
                 $new_source = $CGI::values{$_};
 		$new_source =~ s/[\r\n\t]//g;
-		$Vend::Session->{source} = $new_source;
-                last SOURCEPRIORITY;
+                last SOURCEPRIORITY if defined set_source($new_source, $_);
             }
          }
      }