#!/usr/bin/perl

use strict;
use utf8;
use warnings;

use Cf qw($OTRS_TICKET_SERVER);
use Data::Dump qw(pp);          # depends: libdata-dump-perl
use Getopt::Long;               # depends: perl-base
use Mail::Header;               # depends: libmailtools-perl
use noris::IO::AutoEncoding;    # depends: libnoris-io-autoencoding-perl
use IO::Socket::INET;

use constant DEFAULT_INTERFACES => split ' ', $OTRS_TICKET_SERVER;

# Get CMD Line Options
GetOptions(
    'debug+'      => \( my $Debug = 0 ),
    'interface=s' => \my @Interfaces,
    'timeout=f'   => \( my $Timeout = 3 ),
    'help|?'      => sub {
        exec perldoc => -F => $0
          or die "Cannot exec('perldoc -F $0'): $!\n";
    },
    'version'     => sub {
        print "ticketgen2otrs - Version 0.0.1\n";
        exit 0;
    },
) or exit 1;

sub debug {
    my ( $msg, $dl ) = @_;
    $dl = 1 unless $dl;
    print STDERR $msg . "\n" if $dl <= $Debug;
}

@Interfaces = DEFAULT_INTERFACES unless @Interfaces;

my @header;
while (<STDIN>) {
    last if $_ eq "\n";
    push @header, $_;
}
my $mh = Mail::Header->new( \@header )
  or die "Kann keinen Mail::Header erzeugen.\n";

debug( 'Original Header:' . pp(@header), 3 );

# get ticketnumber or queue from initial mail
my $TicketNumber = $mh->get('X-noris-Ticket-Number');
debug( 'Number:' . ( $TicketNumber ? $TicketNumber : 'Not found' ), 1 );

my $TicketQueue = $mh->get('X-noris-Ticket-Queue');
debug( 'Queue:' . ( $TicketQueue ? $TicketQueue : 'Not found' ), 1 );

my ( $interface, $socket );
for (@Interfaces) {
    $socket = IO::Socket::INET->new(
        PeerAddr => ( $interface = $_ ),
        $Timeout ? ( Timeout => $Timeout ) : ()
    ) and last;

    # Fehlermeldung lautet bei älteren IO::Socket-Versionen
    # "IO::Socket::INET: Timeout", bei neueren
    # "IO::Socket::INET: connect: timeout"
    warn "Error connect()ing to $_: $@" unless $@ =~ /: Timeout$/i;
}

die "Could not connect to any interface.\n" unless $socket;
$socket->print( "ticket_correspondence ticketgen2otrs "
      . ( $TicketNumber || $TicketQueue || "Raw\n" ) )
  or warn "Error print()ing to $interface: $!\n";

$socket->print( 'X-noris-Created-By: ticketgen2otrs' . "\n" )
  or warn "Error print()ing to $interface: $!\n";

# falls keine Queue angegeben dann nimm Raw
unless ( $TicketQueue && $TicketNumber ) {
    $socket->print("X-noris-Ticket-Queue: Raw\n")
      or warn "Error print()ing to $interface: $!\n";
}

$socket->print( @header, "\n", <STDIN> )
  or warn "Error print()ing to $interface: $!\n";

my $ticket = <$socket>;
$socket->close or die "Error closing connection to $interface: $!\n";

# get new ticketnumber from ticketserver
unless ( defined $ticket && $ticket =~ /^(.+)/ ) {
    die "Das Ticketsystem lieferte keine Ticket-ID.\n";
}
else {
    debug( "Der Artikel landete in Ticket $1.", 1 );
    print $ticket;
}

exit 0;

__END__

=head1 NAME

ticketgen2otrs - Proxy um ticketgen -> TicketServer weiterzuleiten

=head1 SYNOPSE

    ticketgen2otrs

=head1 DESCRIPTION

Ticketgen soll abgeschafft werden. Mails die noch an den alten rt ticketgen
geschickt werden sollen an den TicketServer weitergeleitet werden.

=head1 RÜCKGABEWERT

=head1 OPTIONEN

=over 4

=item -debug LEVEL

Je öfters desto gesprächiger

=item -interface

Interface wohin er sich connecten soll. Man kann mehrere angeben

=item -timeout

Socket timeout

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 AUTOREN

 Stelios Gikas <entwicklung@noris.net>
 Stelios Gikas <10136137@ticket.noris.net>

