1#!/usr/bin/perl 2 3# * Copyright 2003-2007 Paul Mangan <paul@claws-mail.org> 4# * 5# * This file is free software; you can redistribute it and/or modify it 6# * under the terms of the GNU General Public License as published by 7# * the Free Software Foundation; either version 3 of the License, or 8# * (at your option) any later version. 9# * 10# * This program is distributed in the hope that it will be useful, but 11# * WITHOUT ANY WARRANTY; without even the implied warranty of 12# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13# * General Public License for more details. 14# * 15# * You should have received a copy of the GNU General Public License 16# * along with this program; if not, write to the Free Software 17# * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 18# * 19 20# Changes: 21# Feb 2007: add support for non ISO-8859-1 compatible locales 22# by Alex Gorbachenko <agent_007@immo.ru> 23# 24 25use Getopt::Long; 26use URI::Escape; 27use POSIX qw(locale_h); 28use Text::Iconv; 29 30my $where = ''; 31my $what = ''; 32 33GetOptions("where=s" => \$where, 34 "what=s" => \$what); 35 36$locale = setlocale(LC_CTYPE); 37$locale =~ s/\S+\.//; 38 39$converter = Text::Iconv->new("$locale", "UTF-8"); 40$safe=uri_escape($converter->convert("$what")); 41$what=$safe; 42 43chdir($ENV{HOME} . "/.claws-mail") 44 || die("Can't find your ~/.claws-mail directory\n"); 45 46open (CONF, "<multiwebsearch.conf") 47 || die("Can't open ~/.claws-mail/multiwebsearch.conf\n"); 48 @conflines = <CONF>; 49close CONF; 50 51foreach $confline (@conflines) { 52 if ($confline =~ m/^$where\|/) { 53 chomp $confline; 54 @parts = split(/\|/, $confline); 55 $url = $parts[1]; 56 if ($parts[2]) { 57 $what .= $parts[2]; 58 } 59 } 60} 61 62if (!$url) { 63 die("No url found with the alias \"$where\"\n"); 64} 65 66open (SYLRC, "<clawsrc") 67 || die("Can't open ~/.claws-mail/clawsrc\n"); 68 @rclines = <SYLRC>; 69close SYLRC; 70 71foreach $rcline (@rclines) { 72 if ($rcline =~ m/^uri_open_command/) { 73 chomp $rcline; 74 @browser = split(/=/, $rcline); 75 $browser[1] =~ s/%s/$url$what/; 76 } 77} 78system("$browser[1]&"); 79exit; 80