tools/multiwebsearch.pl

   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
  25 use Getopt::Long;
  26 use URI::Escape;
  27 use POSIX qw(locale_h);
  28 use Text::Iconv;
  29
  30 my $where = '';
  31 my $what  = '';
  32
  33 GetOptions("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
  43 chdir($ENV{HOME} . "/.claws-mail")
  44         || die("Can't find your ~/.claws-mail directory\n");
  45
  46 open (CONF, "<multiwebsearch.conf")
  47         || die("Can't open ~/.claws-mail/multiwebsearch.conf\n");
  48         @conflines = <CONF>;
  49 close CONF;
  50
  51 foreach $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
  62 if (!$url) {
  63         die("No url found with the alias \"$where\"\n");
  64 }
  65
  66 open (SYLRC, "<clawsrc")
  67         || die("Can't open ~/.claws-mail/clawsrc\n");
  68         @rclines = <SYLRC>;
  69 close SYLRC;
  70
  71 foreach $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 }
  78 system("$browser[1]&");
  79 exit;