allow additional headers to be used when fetching json

1 files changed, 7 insertions, 1 deletions

diff --git a/lib/RHRD/utils.pm b/lib/RHRD/utils.pm
index 13e8ca1..f3a76bf 100755
--- a/lib/RHRD/utils.pm
+++ b/lib/RHRD/utils.pm
@@ -161,7 +161,7 @@ sub cmdline_dow
 
 sub fetch_parse_json
 {
-  my ($url, $ua_str) = @_;
+  my ($url, $ua_str, $headers) = @_;
 
   my $uri = URI->new($url);
   $ua_str = "Radio Helsinki Rivendell Utilities" unless $ua_str;
@@ -169,6 +169,12 @@ sub fetch_parse_json
   my $ua  = LWP::UserAgent->new;
   $ua->agent($ua_str);
   $ua->env_proxy;
+  if (defined $headers) {
+    while(my ($field, $value) = each %{$headers}) {
+      $ua->default_header($field, $value);
+    }
+  }
+
   my $res = URI::Fetch->fetch($uri, UserAgent => $ua)
     or return (0, URI::Fetch->errstr);
   if($res->status == URI::Fetch::URI_GONE()) {