#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;

BEGIN {
    unshift @INC, ( $ENV{'POPHOME'} || '@POPHOME@' ) . '/lib'
      unless $ENV{'KUNDE_NO_PERLPATH'};
}

use Dbase::Getopt;
use URI            ();
use WWW::Mechanize ();

our ( $PARTNERGATE_PARTNER_ID, $PARTNERGATE_USER, $PARTNERGATE_PASSWORD );
eval {
    require Cf;
    Cf->import(
        qw(
          $PARTNERGATE_PARTNER_ID
          $PARTNERGATE_USER
          $PARTNERGATE_PASSWORD
          )
    );
};

my @FillIn = qw(session_id);
GetOptions(
    'login-url=s' => \( my $LoginUrl = 'https://www.partnergate.de/' ),

    # Variablen kopieren, da Konfigurationsvariablen read-only sind:
    'partner-id=s' => \( my $PartnerId = $PARTNERGATE_PARTNER_ID ),
    'user=s'       => \( my $User      = $PARTNERGATE_USER ),
    'password=s'   => \( my $Password  = $PARTNERGATE_PASSWORD ),
    'url=s'        => \(
        my $Url = 'https://www.partnergate.de/export_csv2.php?sort=domain_az'
    ),
    'fillin=s' => sub {
        ( undef, my $value ) = @_;
        if ( length $value ) { push @FillIn, $value }
        else { undef @FillIn }
    },
);

my $uri = URI->new($Url) or die "<$Url> is no valid -url.\n";

my $mech = WWW::Mechanize->new or die;

{    # Einloggen:
    $mech->get($LoginUrl);
    $mech->submit_form(
        form_name => 'LoginForm',
        fields    => { partner => $PartnerId }
    );
    $mech->submit_form(
        form_name => 'LoginForm',
        fields    => { user => $User, pw => $Password }
    );
}

{    # @Fillin-Werte aus Base-URL ermitteln und in $Url einsetzen:
    my $base     = $mech->base;
    my $base_uri = URI->new($base)
      or die "Cannot build URI object from <$base>.\n";

    my %base_query;
    {    # Vorkehrungen für potenziell mehrere gleichnamige Parameter
        my @base_query = $base_uri->query_form;
        for ( my $i = 0 ; $i < $#base_query ; $i += 2 ) {
            push @{ $base_query{ $base_query[$i] } }, $base_query[ $i + 1 ];
        }
    }

    $uri->query_form(
        $uri->query_form,
        map {
            my $param = $_;
            if ( exists $base_query{$param} ) {
                map +( $param => $_ ), @{ $base_query{$param} };
            }
            else { die "<$base_uri> enthält keinen Wert für $_.\n" }
          } @FillIn
    );
}

print $mech->get($uri)->content;

__END__

=head1 NAME

get_domainlist_from_partnergate -
Domainbestand beim Partnergate als CSV-Daten holen

=head1 BESCHREIBUNG

Das Script loggt sich über die Web-Schnittstelle ins PartnerGate ein,
holt eine Liste der registrierten Domains
und gibt diese auf die Standardausgabe aus.

=head1 OPTIONEN

=over 4

=item -login-url URL

URL, bei der der Login-Prozess ansetzen soll;
Default: C<https://www.partnergate.de/>

=item -partner-id Kennung

für den Login zu verwendende Partner-ID.
Kann in der Konfigurationsvariable C<$PARTNERGATE_PARTNER_ID> voreingestellt
werden.

=item -user Benutzername

für den Login zu verwendender Benutzername.
Kann in der Konfigurationsvariable C<$PARTNERGATE_USER> voreingestellt werden.

=item -password Kennwort

für den Login zu verwendendes Kennwort.
Kann in der Konfigurationsvariable C<$PARTNERGATE_PASSWORD> voreingestellt
werden.

=item -url URL

URL, unter der die eigentliche Liste zu finden ist.
Default: C<https://www.partnergate.de/export_csv2.php?sort=domain_az>

=item -fillin Parameter

zur Angabe von Parametern, die aus der nach dem Login aktuellen URL in die
L<-url|URL> übernommen werden müssen, damit die Abfrage funktioniert.
Kann mehrfach verwendet werden, um mehrere Parameter zu übernehmen.
Voreingestellt ist, dass die C<session_id> übernommen wird.
Wird eine leere Zeichenkette als Parameter übergeben, so werden alle
voreingestellten und ggf. bereits angegebenen Werte aus der Liste gelöscht.

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 AUTOR

 Martin H. Sluka <fany@noris.net>
 für die noris network AG
 RT#312622
