#!/usr/bin/perl -w
#  $Id: probe 29580 2013-09-30 13:57:20Z teetov $
# -----------------------------------------------------------------------------
#  Purpose:
#    - probe the camera
#    - pre-tune camera befor for retriever (RC and Audio)
# -----------------------------------------------------------------------------
#  Call:
#    probe DEVID=123
#    probe DEVID=123 PROBE=FAST
#    probe DEVID=123 DEVIP=192.168.17.177 [ ... ]
#    probe DEVIP=192.168.17.177 USRNAME=admin PASSWD=pass PROBE=DEFINE
# -----------------------------------------------------------------------------
#  Does:
#   0. can be called without DEVID argument.
#      In this case DEVIP,USRNAME,PASSWD should be provided in command line
#   1. load $APL_CONF/<DEVID>/conf if DEVID is provided
#   2. combine conf and args into one hash
#   3. connect to camera over http and read MODELID and FIRMWARE
#   4. report MODELID|FIRMWARE|STATUS to $APL_CONF/<DEVID>/conf.probe and stdout
#   5. if PROBE=DEFINE then get
#         IMAGESIZE_LIST,MEDIA_FORMAT_LIST
#         AUDIO_LIST,AUDIO_FORMAT_LIST
#         SNAPSHOT (picture)
#   6. set RC camera attributes    if mpeg4 | h264
#   7. set AUDIO camera attributes if AUDIO is on
#   8. example output:
#       AUDIO_SET=OK
#       FIRMWARE=5.02
#       MODELID=Q1755
#       RC_SET=OK
#       STATUS=OK
#       -------------
#       AUDIO_SET=NONE
#       FIRMWARE=5.02
#       MODELID=Q1755
#       RC_SET=NONE
#       STATUS=OK
#       SNAPSHOT=/tmp/probe/192.168.17.177-12367576123.jpg
#       IMAGESIZE_LIST=640x480,480x360,320x240,240x180,176x144,160x120
#       MEDIA_FORMAT_LIST=mjpeg,h264
#       AUDIO_LIST=off,on
#       AUDIO_FORMAT_LIST=g711,g726,aac
#	CAMERA_LIST=1,2,3,4
#   9. sample errors:
#       STATUS=ERROR: PCE-0001 [101] configuration is not found
#       STATUS=ERROR: PCE-0002 [101] USRNAME and PASSWD should provided
#       STATUS=ERROR: PCE-0003 [101] DEVIP is not defined
#       STATUS=ERROR: PCE-0500 [101] Device does not respond (http://207.107.163.123:80)
#       STATUS=ERROR: PCE-0401 [101] Authorization error
#       STATUS=ERROR: PCE-0403 [101] Forbidden
#       STATUS=ERROR: PCE-0030 [101] Cannot get MODELID
#       note: [101] is DEVID
#  10. warnings:
#       STATUS=WARNING: PCW-0001 [101] MODELID does not match configuration
#       STATUS=WARNING: PCW-0002 [101] FIRMWARE does not match configuration
#       STATUS=WARNING: PCW-0009 [101] PROBE=RESET is not supported
#
# -----------------------------------------------------------------------------
#  Note:
#   1. CAMERAMODEL file is obsolite. ptz_axisv2.pl & ptz_udp.pl has to be modified
#   2. Script mast be in the directory .../camera/<BRAND>/bin/
# -----------------------------------------------------------------------------
#  Author: teetov, 03/22/10
#  Edited by:
#  QA by:
#  Copyright: videoNEXT Network Solutions, Inc, 2010
# -----------------------------------------------------------------------------
#
use strict;
use XML::Simple;
use XML::LibXML;
use Device::Conf ":all";
#use Data::Dumper;

# --------- check required parameters: DEVID,USRNAME,PASSWD,
my $conf=ProbeInit();  # uses <BRAND> from path and ARGV
ProbeErr("PCE-0001","configuration is not found") if not defined $conf->{DEVID};
ProbeErr("PCE-0003","DEVIP is not defined")       if not defined $conf->{DEVIP};
ProbeErr("PCE-0002","USRNAME and PASSWD should be provided")
                 if not defined $conf->{USRNAME} or not defined $conf->{PASSWD};
ProbeWarn("PCW-0009","PROBE=RESET is not supported") if $conf->{PROBE} eq 'RESET';
#------------------------------------------------------------------------------
# Probe camera MODELID & FIRMWARE
#------------------------------------------------------------------------------
my %result=(MODELID=>'0',FIRMWARE=>'0.0',STATUS=>'OK',RC_SET=>'NONE',AUDIO_SET=>'NONE');

UA()->timeout(5);

my $rsp = ProbeRequest("/ISAPI/System/deviceInfo");
if ($rsp !~ /^HTTP ERROR/) {
    my $parsed = eval { XMLin $rsp };
    ProbeErr("PCE-0500","Inivalid response",$rsp) if $@;
    $result{MODELID} = $parsed->{model};
    $result{FIRMWARE} = $parsed->{firmwareVersion};
} else {
    my ($err) = $rsp =~ /^HTTP ERROR \[(\d+)\]/;
    ProbeErr("PCE-0500","Device does not respond",$rsp) if $err=~/^5\d\d/;
    ProbeErr("PCE-0401","Authorization error",    $rsp) if $err==401;
}

# Get camera capabilities
#------------------------------------------------------------------------------
my %codec2mf = ( # Conversion 'HikVision codec' => 'SKM media format'
    'MPEG4' => 'mpeg4',
    'H.264' => 'h264',
    'MJPEG' => 'mjpg'
);
my %mf2codec = (
    'mjpg'  => 'MJPEG',
    'mpeg4' => 'MPEG4',
    'h264'  => 'H.264'
);
my @maxbitrate = (256,512,1024,2048,3072,4096,6144,8192,12288,16384);
my $parser = XML::LibXML->new();
my %channels;
my $mainChannelXML;
my $mainChannelID;

if ($conf->{PROBE} eq 'DEFINE' or $conf->{DEVID} ne '0') {
    # Get Streaming channels configuration
    # Fist find ID of main channel
    my ($xml, $rsp) = loadXML("/ISAPI/Streaming/channels");
    my @channels = $xml->getElementsByTagName('StreamingChannel');
    my $camera = $conf->{CAMERA};
    my @chids;
    foreach my $ch (@channels) {
        my $chid = getChildVal($ch, 'id');
        $channels{$chid} = $ch;
        if (defined $camera and $chid eq $camera) {
            $result{CAMERA} = $camera;
            $mainChannelXML = $ch;
            last;
        }
        elsif (not defined $camera) {
            push @chids, $chid;
        }
    }
    if (not defined $result{CAMERA}) {
        ProbeErr("PCE-0500","Cannot find channel",$rsp) if not @chids;
        my $min_id;
        foreach my $chid (@chids) {
            $min_id = $chid, next if not defined $min_id;
            $min_id = $chid if $chid < $min_id;
        }
        $result{CAMERA} = $min_id;
        $mainChannelXML = $channels{$min_id};
    }
    $mainChannelID = $result{CAMERA};
    # Define CAMERA_LIST for GUI correct snapshot displaying
    $result{CAMERA_LIST} = $result{CAMERA};
}

if($conf->{PROBE} eq 'DEFINE') {
    # Get video streaming parameters
    # Define MEDIA_FORMAT_LIST, IMAGESIZE_LIST, RTP_OVER_TCP_LIST and RC_MAXBITRATE_LIST
    
    my ($xml, $rsp) = loadXML("/ISAPI/Streaming/channels/$mainChannelID/capabilities");
    my $codecList = getAttrVal($xml, 'videoCodecType', 'opt');
    ProbeErr("PCE-0500","Cannot get supported codecs",$rsp) if not $codecList;
    $result{MEDIA_FORMAT_LIST} = join(',', map { $codec2mf{$_} } split /,/, $codecList);
    
    my $imagesizeList = "";
    my $resWidthList = getAttrVal($xml, 'videoResolutionWidth', 'opt');
    my $resHeightList = getAttrVal($xml, 'videoResolutionHeight', 'opt');
    my @resWidth = split /,/, $resWidthList;
    my @resHeight = split /,/, $resHeightList;
    $imagesizeList .= $resWidth[$_].'x'.$resHeight[$_].','  foreach 0..$#resWidth;
    chop $imagesizeList;
    $result{IMAGESIZE_LIST} = $imagesizeList;
    
    my $rtpTransportList = getAttrVal($xml, 'rtpTransportType', 'opt');
    my @rtp_opts;
    my $rtp_def_opt;
    foreach my $opt (split /,/, $rtpTransportList) {
        if ($opt eq 'RTP/UDP') {
            push @rtp_opts, 'off:OFF';
            $rtp_def_opt = 'off';
        } elsif ($opt eq 'RTP/TCP') {
            push @rtp_opts, 'on:ON';
        }
    }
    $rtp_def_opt = 'on' if not $rtp_def_opt;
    $result{RTP_OVER_TCP_LIST} = join ',', @rtp_opts;
    $result{RTP_OVER_TCP} = $rtp_def_opt;
    
    my $vbrUpperCapMax = getAttrVal($xml, 'vbrUpperCap', 'max');
    my $mbrCur = $maxbitrate[$#maxbitrate];
    # Must drop elements that are greater than camera's vbrUpperCapMax
    pop @maxbitrate while $maxbitrate[$#maxbitrate] > $vbrUpperCapMax;
    push @maxbitrate, $vbrUpperCapMax if $maxbitrate[$#maxbitrate] < $vbrUpperCapMax;
    push @maxbitrate, 'cam-defined';
    $result{RC_MAXBITRATE_LIST} = join ',', @maxbitrate;
    
    # Get dynamic streaming capabilities
    # Define FRAMERATE_LIST which depends on image resolution
    ($xml, $rsp) = loadXML("/ISAPI/Streaming/channels/$mainChannelID/dynamicCap");
    my @resDesc = $xml->getElementsByTagName('ResolutionAvailableDscriptor');
    my $framerateList = "";
    foreach my $resDesc (@resDesc) {
        my $resWidth = getVal($resDesc, 'videoResolutionWidth');
        my $resHeight = getVal($resDesc, 'videoResolutionHeight');
        my $frList = getVal($resDesc, 'supportedFrameRate');
        $frList = join(',', map { $_/=100 } split /,/, $frList); # Convert framerate values
        $frList =~ s/,/\\,/g; # Escape commas
        $framerateList .= $resWidth.'x'.$resHeight.':'.$frList.',';
    }
    chop $framerateList;
    $result{FRAMERATE_LIST} = $framerateList;
    
    # Get Audio capabilities
    # Define AUDIO_LIST
    $result{AUDIO_LIST} = "off:OFF,";
    ($xml, $rsp) = loadXML("/ISAPI/System/Audio/capabilities");
    my $audioInputNums = int(getVal($xml, 'audioInputNums'));
    my $audioOutputNums = int(getVal($xml, 'audioOutputNums'));
    $result{AUDIO_LIST} .= "on:ON," if $audioInputNums > 0 and $audioOutputNums == 0;
    $result{AUDIO_LIST} .= "on:ON (1-WAY),on_2way:ON (2-WAY)," if $audioInputNums > 0;
    chop $result{AUDIO_LIST};
    
    # Get PTZ capabilities
    # Define POSITIONCTL_LIST
    ($xml, $rsp) = loadXML("/ISAPI/PTZCtrl/channels");
    my @ptz = $xml->getElementsByTagName('PTZChannel');
    $result{POSITIONCTL_LIST} = @ptz ? 'none,HikVision' : 'none';
    $result{POSITIONCTL} = 'none' if not @ptz;
    if (@ptz) {
        my @ptzids;
        foreach my $ptz (@ptz) {
            my $ptzid = getVal($ptz, 'id');
            next if not defined $ptzid;
            push @ptzids, $ptzid;
        }
        $result{PTZID_LIST} = join ',', @ptzids;
        $result{PTZID} = $ptzids[0];
    }
}

# get Sample picture
#------------------------------------------------------------------------------
if($conf->{PROBE} eq 'DEFINE') {
    $result{SNAPSHOT_LIST}=ProbeSnapshotList($result{CAMERA_LIST});
}
#------------------------------------------------------------------------------
# interim report & exit
#------------------------------------------------------------------------------
ProbeResult(\%result)  if $conf->{PROBE} =~ /^(DEFINE|FAST)$/;
ProbeResult(\%result)  if $conf->{DEVID} eq '0';

#------------------------------------------------------------------------------
# set RC (rate control) parameters
#------------------------------------------------------------------------------

my %statusCodes = (
    '1' => 'OK',
    '2' => 'Device Busy',
    '3' => 'Device Error',
    '4' => 'Invalid Operation',
    '5' => 'Invalid XML Format',
    '6' => 'Invalid XML Content',
    '7' => 'Reboot required'
);

# codec
setVal($mainChannelXML, 'videoCodecType', $mf2codec{$conf->{MEDIA_FORMAT}});
# resolution
my ($width, $height) = split /x/, $conf->{IMAGESIZE};
setVal($mainChannelXML, 'videoResolutionWidth', $width);
setVal($mainChannelXML, 'videoResolutionHeight', $height);
# rate control mode
setVal($mainChannelXML, 'videoQualityControlType', uc($conf->{RC_MODE}));
# Image quality for variable bitrate
setVal($mainChannelXML, 'fixedQuality', $conf->{CAMCOMPRESSION});
# constant bit rate
setVal($mainChannelXML, 'constantBitRate', $conf->{RC_MAXBITRATE})
    if $conf->{RC_MAXBITRATE} ne 'cam-defined';
# Maximum bitrate for vbr
setVal($mainChannelXML, 'vbrUpperCap', $conf->{RC_MAXBITRATE})
    if $conf->{RC_MAXBITRATE} ne 'cam-defined';
# framerate
setVal($mainChannelXML, 'maxFrameRate', $conf->{FRAMERATE} * 100);
# Audio
setVal($mainChannelXML, 'enabled', $conf->{AUDIO} eq 'on' ? 'true' : 'false', 'Audio');
setVal($mainChannelXML, 'audioCompressionType', 'G.711ulaw', 'Audio');

# Send request
#print "Requesst:\n".$mainChannelXML->toString."\n";
$rsp = ProbeRequest(
    "/ISAPI/Streaming/channels/$mainChannelID", 
    'PUT',
    ['Content-Type'=>'application/xml'],
    $mainChannelXML->toString
) unless $conf->{ENCODER_SETTING_OVERRIDE} eq 'no';
ProbeErr('PCE-0500','Device respond error',$rsp) if $rsp =~ /^HTTP ERROR \[(\d+)\]/;
#print "Response action=set ->\n".$rsp."\n";
my $rsp_parsed = $parser->parse_string($rsp);
my ($statusCode, $statusString) = (getVal($rsp_parsed, 'statusCode'), getVal($rsp_parsed, 'statusString'));
if (defined $statusCode and $statusCode ne '1') {
    my $msg = exists $statusCodes{$statusCode} ? $statusCodes{$statusCode} : 'Unknown error';
    ProbeErr('PCE-0500',"$msg - $statusString", $rsp);
}
$result{RC_SET} = 'YES';

my $audio_set = 'YES';
# Configure two-way audio if camera has output channel
if ($conf->{AUDIO_TWO_WAY}) {{
    my ($xml,$rsp) = loadXML("/ISAPI/System/TwoWayAudio/channels/1", 1);
    $audio_set = "ERROR: $rsp", last if not defined $xml;
    my $status = getVal($xml, 'statusCode');
    last if defined $status and $status ne '1';
    setVal($xml, 'enabled', $conf->{AUDIO_TWO_WAY} eq 'on' ? 'true' : 'false');
    setVal($xml, 'audioCompressionType', 'G.711ulaw');
    $rsp = ProbeRequest(
        "/ISAPI/System/TwoWayAudio/channels/1", 
        'PUT', 
        ['Content-Type'=>'application/xml'], 
        $xml->toString
    );
    $audio_set = "ERROR: Device respond error",last if $rsp =~ /^HTTP ERROR \[(\d+)\]/;
    my $rsp_parsed = $parser->parse_string($rsp);
    my ($statusCode, $statusString) = (getVal($rsp_parsed, 'statusCode'), getVal($rsp_parsed, 'statusString'));
    if (defined $statusCode and $statusCode ne '1') {
        my $msg = exists $statusCodes{$statusCode} ? $statusCodes{$statusCode} : 'Unknown error';
        $audio_set = "ERROR: $msg - $statusString";
    }
}}

$result{AUDIO_SET} = $audio_set;

# final report-----------------------------------------------------------------------
ProbeResult(\%result);

sub loadXML {
    my ($url, $nothrow) = @_;
    my $rsp = ProbeRequest($url);
    if ($rsp =~ /^HTTP ERROR \[(\d+)\]/) {
        if ($nothrow) {
            return (undef, 'Device respond error');
        } else {
            ProbeErr('PCE-0500','Device respond error',$rsp) 
        }
    }
    my $xml;
    eval {
        $xml = $parser->parse_string($rsp);
    };
    if ($@) {
        if ($nothrow) {
            return (undef, 'Invalid response from device');
        } else {
            ProbeErr('PCE-0500','Invalid response from device',$rsp);
        }
    }
    return ($xml, $rsp);
}

sub getVal {
    my ($node, $tagName, $childOnly) = @_;
    my @el;
    if ($childOnly) {
        @el = $node->getChildrenByTagName($tagName);
    } else {
        @el = $node->getElementsByTagName($tagName);
    }
    return undef if not @el;
    return $el[0]->firstChild->nodeValue;
}

sub getAttrVal {
    my ($node, $tagName, $attrName) = @_;
    my @el = $node->getElementsByTagName($tagName);
    return undef if not @el;
    return $el[0]->getAttribute($attrName);
}

sub getChildVal {
    return getVal(@_, 1);
}

sub setVal {
    my ($node, $tagName, $val, $parentTagName) = @_;
    $node = ($node->getElementsByTagName($parentTagName))[0] if $parentTagName;
    return unless $node;
    my $el = ($node->getElementsByTagName($tagName))[0];
    
    if (defined($el)) {
        $el->removeChild($el->firstChild);
        $el->appendTextNode($val);
    } else {
        my $newNode = XML::LibXML::Element->new($tagName);
        $newNode->appendTextNode($val);
        $node->appendChild($newNode);
    }
}
