#!/usr/bin/env perl
# rtsp_client.pl --- 
# Author: Eduardo <eduardo@eduardors.net>
# Created: 2014/12/21 02:12:42
# Version: 0.0.1

use warnings;
use strict;
use Carp;

use IO::Socket::INET;


my $server_ip = shift || '192.168.100.33';
my $rtp_port  = shift || 27915;
my $rtcp_port = $rtp_port + 1;
my $session;
my $cip = '192.168.200.33';
my $cseq = 1;

my @describe = ( "DESCRIBE rtsp://${server_ip}:554/vod1_diascontadosV2PR.mpi RTSP/1.0",
                 'CSeq: %d',
                 'User-Agent: MICA-IP-STB',
                 'Accept: application/sdp',
                 );

my @setup = ( "SETUP rtsp://${server_ip}:554/vod1_diascontadosV2PR.mpi RTSP/1.0",
              'User-Agent: MICA-IP-STB',
              "Transport: MP2T/H2221/UDP;unicast;client_port=$rtp_port-$rtcp_port",
              'CSeq: %d',
               );

my @play = ( "PLAY rtsp://${server_ip}:554/vod1_diascontadosV2PR.mpi RTSP/1.0",
             "CSeq: %d",
             "Session: %s",
             "User-Agent: MICA-IP-STB",
             "Range: npt=current-end",
             "Scale: 1.000",
             "x-playNow:",
             "x-noFlush:",
          );

my @teardown = ( "TEARDOWN rtsp://${server_ip}:554/vod1_diascontadosV2PR.mpi RTSP/1.0",
                 'CSeq: %d',
                 'Session: %s',
                 'User-Agent: MICA-IP-STB',
                 'x-reason: released',
                 );


my $s = IO::Socket::INET->new( PeerAddr => $server_ip,
                               PeerPort => 554,
                               Proto    => 'tcp',
                            );

describe();
setup();
play();
teardown();

shutdown( $s, 1 );

$s->close();

exit 0;

# ----------------------------------------------------------------------------

sub describe
{
   tx( $s, @describe );
   my $data = rx( $s );
   $cip = $1 if $data =~ /o=- \d+\s+\d+\s+IN\s+IP4\s+(\d+\.\d+\.\d+\.\d+)/;
}

# ----------------------------------------------------------------------------

sub setup
{
   tx( $s, @setup );
   my $data = rx( $s );
   $session = $1 if $data =~ /Session: ([^;]+)/;
}

# ----------------------------------------------------------------------------

sub play
{
   my @tmp;
   foreach ( @play )
   {
      $_ = sprintf "$_", $session if /^Session/;
      push @tmp, $_;
   }

   my $ip = $s->peerhost();
   my $rtp_pid = fork();
   if ( 0 == $rtp_pid )
   {
      server_rtp( $cip, $rtp_port );
      exit 0;
   }

   print "[*] father $$, child $rtp_pid\n";
   sleep 1;
   tx( $s, @tmp );
   rx( $s );
   waitpid $rtp_pid, 0;
}

# ----------------------------------------------------------------------------

sub teardown
{
   my @tmp;
   foreach ( @teardown )
   {
      $_ = sprintf "$_", $session if /^Session/;
      push @tmp, $_;
   }
   tx( $s, @tmp );
   rx( $s );
}

# ----------------------------------------------------------------------------

sub rx
{
   my ( $s ) = @_;
   my $data;

   $s->recv( $data, 1024 );
   print "$data\n";
   $data;
}

# ----------------------------------------------------------------------------

sub tx
{
   my ( $s, @msg ) = @_;
   my $msg;

   foreach ( @msg )
   {
      $_ = sprintf "$_", $cseq++ if /^CSeq:/;
      $msg .= "$_\r\n";
   }
   $msg .= "\r\n";

   $s->send( $msg );
}

# ----------------------------------------------------------------------------

sub server_rtp
{
   my ( $ip, $port ) = @_;

   print "[*] udp $ip:$port\n";
   my $rtp = IO::Socket::INET->new( LocalAddr => $ip,
                                    LocalPort => $port,
                                    Proto     => 'udp',
                                    Reuse     => 1,
                                 )
             || die "Error create server: $!\n";

   rx( $rtp );
   shutdown( $rtp, 1 );
   $rtp->close();
   exit 0;
}

# ----------------------------------------------------------------------------

__END__

=head1 NAME

rtsp_client.pl - Describe the usage of script briefly

=head1 SYNOPSIS

rtsp_client.pl [options] args

      -opt --long      Option description

=head1 DESCRIPTION

Stub documentation for rtsp_client.pl, 

=head1 AUTHOR

Eduardo, E<lt>eduardo@eduardors.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014 by Eduardo

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 CHANGES

 0.0.1  2014-12-21  Init version.

=head1 BUGS

None reported... yet.

=cut