Ищем по metal-archives.com

Потребовалось мне тут давеча много и нудно искать всякие разнообразные альбомы на митал-архивах. И поскольку я обладаю всеми доблестями perl программиста (лень, нетерпимость, высокомерие, если кто не знал), то решил я это дело немножечко автоматизировать
Поиск по CPAN не дал ничего (Perl’s killer feature, ага), что очень странно - неужто никто из матерых perlовщиков не слушает металл например ? Пришлось писать самому. Сорец прилагается

Пользоваться очень просто - в командной строке задается две опции - либо -a имя альбома либо -b имя группы
Надо бы оформить в виде отдельного perl package, но мне опять же лень

#!/usr/bin/perl
# Lame metal-archives searcher
# 25 jul 2010 (C) RedPlait
use strict;
use warnings;

###### some global settings ######
my $ROOT_URL = 'http://metal-archives.com/';
my $MENU_URL = $ROOT_URL . 'menu.php';
my $SEARCH_URL = $ROOT_URL . 'search.php?PHPSESSID=';

# Каким броузером прикидыватца
my $USER_AGENT='Opera/666 (Windows NT 3.51; U; ru) Presto/14.88';

# если есть http-proxy - для него настройки
my $PROXY_SETTINGS; #='http://89.0.0.10:8080/';

use LWP::UserAgent;
use HTTP::Request::Common qw(GET);
use HTTP::Request;
use HTTP::Headers;
use HTTP::Cookies;
use URI::Escape;
use Getopt::Std;
use vars qw/$opt_a $opt_b $opt_d $opt_p $opt_v/;

sub usage()
{
    print STDERR <<EOF;
Usage is $0 [options]
Options:
  -a -- album name
  -b -- band name
  -d -- dont remove tmp files (for debug only)
  -p -- proxy settings
  -v -- Verbose mode
EOF
    exit (8);
}

sub extract_phpsessid
{
  my $fname = shift;
  open(FILE, '<', $fname) or die("Cannot open $fname");
  my($str, $res);
  while( $str = <FILE> )
  {
    chomp $str;
    next if ( $str !~ /\?PHPSESSID=([0-9a-f]+)\"/ );
    $res = $1;
    last;
  }
  close FILE;
  unlink $fname;
  return $res;
}

sub parse_band_res
{
  my($fname, $band) = @_;
  open(FILE, '<', $fname) or die("parse_band_res: cannot open $fname");
  my($str, @res);
  while( $str = <FILE> )
  {
    chomp $str;
    $str =~ s/^\s+//g;
    last if ( $str =~ /No results found\./ );
    if ( $str =~ /location.href\s*=\s*'([^']+)'/i )
    {
      push @res, [ $1, $band ];
      last;
    }
    if ( $str =~ /^<\/table>/ )
    {
      my @items = split /<td nowrap='true'>/, $str;
      shift @items;
      foreach $str ( @items )
      {
        next if ( $str !~ /^<a href='([^']+)'>(.+)<\/a>/ );
        push @res, [ $1, $2 ];
      }
      last;
    }
  }
  close FILE;
  unlink $fname unless defined $opt_d;
  return \@res;
}

sub parse_album_res
{
  my($fname, $album) = @_;
  open(FILE, '<', $fname) or die("parse_album_res: cannot open $fname");
  my($str, @res, $band, $band_id, $album_id, $name);
  while( $str = <FILE> )
  {
    chomp $str;
    $str =~ s/^\s+//g;
    last if ( $str =~ /No results found\./ );
    if ( $str =~ /location.href\s*=\s*'([^']+)'/i )
    {
      push @res, [ undef, undef, $1, $album ];
      last;
    }
    if ( $str =~ /^<\/table>/ )
    {
      my @items = split /<td nowrap='true'>/, $str;
      shift @items;
      foreach $str ( @items )
      {
                                     # bandId band                       albumID  album
        next if ( $str !~ /^<a href='([^']+)'>(.+)<\/a><\/td><td><a href='([^']+)'>(.+)<\/a><\/td>/ );
        ($band_id, $band, $album_id, $name) = ($1, $2, $3, $4);
        $name =~ s/<strong>//g;
        $name =~ s/<\/strong>//g;
        push @res, [ $band_id, $band, $album_id, $name ];
      }
      last;
    }
  }
  close FILE;
  unlink $fname unless defined $opt_d;
  return \@res;
}

sub dump_band_res
{
  my $aref = shift;
  foreach (@$aref)
  {
    printf("%s %s\n", $_->[1], $_->[0]);
  }
}

sub dump_album_res
{
  my $aref = shift;
  foreach (@$aref)
  {
    if ( defined($_->[1]) )
    {
      printf("%s - %s\n", $_->[1], $_->[3]);
    } else {
      printf("%s %s\n", $_->[3], $_->[2]);
    }
  }
}

#
# MAIN
#
my $status = getopts("a:b:p:dv");
if ($status == 0)
{
    usage();
}
$PROXY_SETTINGS = $opt_p if ( defined $opt_p );
usage() if ( !defined($opt_a) and !defined($opt_b) );

my $cookies = new HTTP::Cookies;
my $ua = new LWP::UserAgent(keep_alive => 1);
$ua->agent($USER_AGENT) if ( defined $USER_AGENT );
$ua->proxy(['http'], $PROXY_SETTINGS) if ( defined $PROXY_SETTINGS );
my $request = new HTTP::Request('GET', $MENU_URL);
$cookies->add_cookie_header($request);
my $response = $ua->request($request, "menu");
if ( !$response->is_success )
{
  printf("Cannot get main page\n");
  exit 0;
}
my $sessid = extract_phpsessid("menu");
$cookies->extract_cookies($response);

# O`k, now we got sessid and can search something
my $url = $SEARCH_URL . $sessid . '&string=';
my($parser, $dumper);
if ( defined $opt_a )
{
  $url .= uri_escape($opt_a) . '&type=album';
} else {
  $url .= uri_escape($opt_b) . '&type=band';
}
printf("requesting %s\n", $url) if ( defined $opt_v );
$request = new HTTP::Request('GET', $url);
$cookies->add_cookie_header($request);
$response = $ua->request($request, "res2");
if ( !$response->is_success )
{
  printf("Cannot search\n");
  exit 0;
}
if ( defined $opt_b )
{
  my $arefs = parse_band_res("res2", $opt_b);
  dump_band_res($arefs) if ( defined $arefs );
} else {
  my $arefs = parse_album_res("res2", $opt_a);
  dump_album_res($arefs) if ( defined $arefs );
}