#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use WWW::Mechanize;

# options par défaut
my %CONF = (
    verbose => 0,
    base    => 'ebay.fr',
    userid  => '',          # À compléter avec vos identifiant
    pass    => '',          # et mot de passe
);

# récupération des paramètres de ligne de commande
GetOptions( \%CONF, "verbose!", "base=s", "userid=s", "pass=s" )
  or die << 'USAGE';
Options disponibles :
  --base    <site>      : base site (ebay.fr, ebay.com, etc.)
  --userid  <userid>
  --pass    <password>
  --verbose
USAGE

# calcul des URL spécifiques
my %url = (
    signin => "http://signin.$CONF{base}/ws/eBayISAPI.dll?SignIn",
    sales  =>
      "http://my.$CONF{base}/ws/eBayISAPI.dll?MyeBay&CurrentPage=MyeBaySelling",
    bids      => "http://offer.$CONF{base}/ws/eBayISAPI.dll?ViewBids&item=",
    cancelbid => "http://offer.$CONF{base}/ws/eBayISAPI.dll?CancelBidShow"
);

# création du robot
my $m = WWW::Mechanize->new();

# récupération du formulaire
$m->get( $url{signin} );
die "Échec de connexion à la page de login : " . $m->res()->status_line()
  unless $m->success();

# remplissage et validation
$m->form_number(2);
$m->set_fields(
    userid => $CONF{userid},
    pass   => $CONF{pass},
);
$m->submit();
die "Échec d'envoi du formulaire : " . $m->res()->status_line()
  unless $m->success();

# identification réussie ?
{
    my $ok = 0;
    $m->cookie_jar()->scan( sub { $ok++ if $_[1] eq 'secure_ticket' } );
    die "Échec du login : informations d'ouverture de session invalides"
      unless $ok;

    print "Connecté à $CONF{base} en tant que $CONF{userid}\n"
      if $CONF{verbose};
}

# récupération de "mes ventes"
$m->get( $url{sales} );
die 'Échec de connexion à "mes ventes" : ' . $m->res()->status_line()
  unless $m->success();

my @ventes = $m->find_all_links( url_regex => qr/\?ViewItem.*&item=\d+/ );

# traitement de chaque objet en vente
for my $item (@ventes) {

    my ($id) = ( $item->url() =~ /item=(\d+)/g );
    print "Objet : ", $item->text(), " ($id)\n" if $CONF{verbose};

    # connexion directe à l'historique des enchères sur cet objet
    $m->get( $url{bids} . $id );
    do {
        warn "Échec de connexion aux enchères de l'objet $id : "
          . $m->res()->status_line();
        $m->back();
        next;
      }
      unless $m->success();

    # détection des enchérisseurs avec profil négatif ou nul
    my @negs = $m->find_all_links(
        url_regex  => qr/\?ViewFeedBack/,
        text_regex => qr/^[-0]/,
    );

    my %negs;
    foreach my $link (@negs) {
        $link->url() =~ /(?:userid|ReturnUserEmail&requested)=(.+?)(?:&|$)/;

        # ajoute la clé correspondant au pseudonyme dans le hash
        $negs{$1} = '';
    }

    # suppression des enchères non souhaitées
    foreach my $pseudo ( keys %negs ) {
        $m->get( $url{cancelbid} );
        $m->submit_form(
            form_number => 2,
            fields      => {
                item        => $id,
                buyeruserid => $pseudo,
                info        =>
                  "Profil <= 0 ; n'a pas pris contact avant d'enchérir."
            }
        );
        $m->back();
    }
    $m->back();
}