New Post: DVBLink recordings metadata

That's great.

I have updaed the script as follows and it is working for me. I am kicking out a .arg file because it seemed to be the easiest format to support.

The parameters in my profile file are as follows:

PreMetaCustomCommandPath=C:\Perl64\bin\perl.exe
PreMetaCustomCommandParameters=c:\code\dvblink.pl %sourcefile%
PreMetaCustomCommandHangPeriod=0
PreMetaCustomCommandCritical=true

To use this you just need to copy the code below into a file dvblink.pl and update your profile file.

#!/usr/bin/perl -w

use strict;
use warnings;

use LWP::UserAgent;
use HTTP::Request::Common;
use XML::Simple;
use XML::Parser;
use XML::LibXML;
use Data::Dumper;
use Text::CSV;
use XML::LibXML::PrettyPrint;
use XML::LibXML::Iterator;
use XML::Writer;

my @epg;

main();

sub main
{
    (my $file) = @ARGV;
    
    print 'searching for file =' . $file . "\n\r";
    
my $message = "command=get_object&xml_param=<?xml version=\"1.0\" encoding=\"UTF-8\" ?> " .
 "<object_requester xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"" .
      "xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xmlns=\"http://www.dvblogic.com\">" .
     " <object_type>-1</object_type>" .
     " <item_type>-1</item_type>" .
     " <start_position>0</start_position>" .
     " <requested_count>-1</requested_count>" .
     " <children_request>true</children_request>" .
     " <server_address>192.168.0.30/server_address>" .
  "</object_requester>";

####
 my $cnt = call_dvblink("127.0.0.1","8080","username","password",$message);

 my $objectid1 = get_objectid ($cnt);

#### #second query 

 $message = "command=get_object&xml_param=<?xml version=\"1.0\" encoding=\"UTF-8\" ?> " .
 "<object_requester xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"" .
      "xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xmlns=\"http://www.dvblogic.com\">" .
     " <object_id>$objectid1</object_id>" .
     " <object_type>-1</object_type>" .
     " <item_type>-1</item_type>" .
     " <start_position>0</start_position>" .
     " <requested_count>-1</requested_count>" .
     " <children_request>true</children_request>" .
     " <server_address>192.168.0.30</server_address>" .
  "</object_requester>";

 my $ccnt =call_dvblink("127.0.0.1","8080","username","password",$message);

 my $objectid2 = get_objectid($ccnt);

##### third query 
 $message = "command=get_object&xml_param=<?xml version=\"1.0\" encoding=\"UTF-8\" ?> " .
 "<object_requester xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"" .
      "xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xmlns=\"http://www.dvblogic.com\">" .
     " <object_id>$objectid2</object_id>" .
     " <object_type>-1</object_type>" .
     " <item_type>-1</item_type>" .
     " <start_position>0</start_position>" .
     " <requested_count>-1</requested_count>" .
     " <children_request>true</children_request>" .
     " <server_address>192.168.0.30</server_address>" .
  "</object_requester>";

 my $ccnt =call_dvblink("127.0.0.1","8080","username","password",$message);

 parse_list ($ccnt, $file);
 

}

sub get_objectid{                                      

 my $inputstring = $_[0];
 my $parser = XML::LibXML-> new();
 my $tree = $parser->parse_string($inputstring);

 my $root = $tree->getDocumentElement ;
 my $xpc = XML::LibXML::XPathContext->new($root);
 $xpc->registerNs("dvbl","http://www.dvblogic.com");

 my $rec = $xpc->findnodes('//dvbl:response/dvbl:xml_result');
 my ($xmlres) = $rec->get_nodelist; 

# print $xmlres;
 $xmlres =~ s/\&lt\;/\</g;
 $xmlres =~ s/\&gt\;/\>/g;
 $xmlres =~ s/<\?xml version=\"1.0\" encoding=\"UTF-8\"\?>//g;
 

                                                                       
 $tree = $parser->parse_string($xmlres);
 $root = $tree->getDocumentElement;
 $xpc = XML::LibXML::XPathContext->new($root);
 $xpc->registerNs("dvbl","http://www.dvblogic.com");
 # my @rec = $xpc->findnodes('//dvbl:object/dvbl:containers/dvbl:container[@dvbl:source_id="8F94B459-EFC0-4D91-9B29-EC3D72E92677"]');
 #my @recc = $xpc->findnodes('//dvbl:object/dvbl:containers/dvbl:container/dvbl:object_id[@source_id="8F94B459-EFC0-4D91-9B29-EC3D72E92677"]');
 my ($recc) = $xpc->findnodes('//dvbl:object/dvbl:containers/dvbl:container/dvbl:object_id');
 my $objectid=$recc->to_literal;
 return $objectid;
}


sub call_dvblink {
# server ip, port username, password, message
 my $userAgent = LWP::UserAgent->new(agent => 'perl post');

 my $message = $_[4];

 $userAgent->credentials($_[0].":".$_[1],"DVBLink Server",$_[2],$_[3]);

 my $response = $userAgent->request(POST 'http://'.$_[0].":".$_[1].'/cs/',
                           Content_Type => 'application/x-www-form-urlencoded',
                           Content => $message);
 print $response->error_as_HTML unless $response->is_success;
 return $response->content;

}

sub parse_list{                                      

 my $inputstring = $_[0];
 my $file = $_[1];

 my $parser = XML::LibXML-> new();
 my $tree = $parser->parse_string($inputstring);

 my $root = $tree->getDocumentElement ;
 my $xpc = XML::LibXML::XPathContext->new($root);
 $xpc->registerNs("dvbl","http://www.dvblogic.com");

my $rec = $xpc->findnodes('//dvbl:response/dvbl:xml_result');
my ($xmlres) = $rec->get_nodelist; 

 $xmlres =~ s/\&lt\;/\</g;
 $xmlres =~ s/\&gt\;/\>/g;
 $xmlres =~ s/<\?xml version=\"1.0\" encoding=\"UTF-8\"\?>//g;

# print $xmlres;
 my $name;
 my $subname;
 my $starttime;
 my $plot;
 my $channel;\
 my $season;
 my $episode;
                                                                       
 $tree = $parser->parse_string($xmlres);
 $root = $tree->getDocumentElement;
 $xpc = XML::LibXML::XPathContext->new($root);
 $xpc->registerNs("dvbl","http://www.dvblogic.com");
 my $recc = $xpc->findnodes('//dvbl:object/dvbl:items/dvbl:recorded_tv');
 if ($file =~ m/([0-9]*-[0-9]*-[0-9]+)\.ts/g){
    my $id = $1;
    foreach my $context ($recc->get_nodelist) {
        my $objectid = $context->getElementsByTagName('object_id');
        my @tag = split("/",$objectid);
        
        if ($id =~ $tag[1]){
            print 'found file '. $file;
            my $scheduleid = $context->getElementsByTagName('schedule_id');
            my $xpc2 = XML::LibXML::XPathContext->new($context);
            $xpc2->registerNs("dvbl","http://www.dvblogic.com");
            $name = $xpc2->findnodes('./dvbl:video_info/dvbl:name');

            $subname = $xpc2->findnodes('./dvbl:video_info/dvbl:subname');
            $plot = $xpc2->findnodes('./dvbl:video_info/dvbl:short_desc');
            $channel = $xpc2->findnodes('./dvbl:channel_name');
            $episode = $xpc2->findnodes('./dvbl:video_info/dvbl:episode_num');
            $season = $xpc2->findnodes('./dvbl:video_info/dvbl:season_num');
            $starttime = $xpc2->findnodes('./dvbl:video_info/dvbl:start_time');
            my $duration = $xpc2->findnodes('./dvbl:video_info/dvbl:duration');


            my $rectime = timestamp($starttime);
            $file =~ s/\.ts/\.arg/g;

            my $xml = XML::LibXML::Document->new( '1.0', 'utf-8' ); 

            open (MYFILE, '>'.$file); 

            my $output = '';
            my $writer = XML::Writer->new(
            OUTPUT=> \$output,
            ENCODING => 'utf8',
            );

            $writer->xmlDecl('UTF-8');
            $writer->startTag('Recording');
            $writer->dataElement(ChannelDisplayName => $channel);
            $writer->dataElement(Title => $name);
            $writer->dataElement(Description => $plot);
            $writer->dataElement(RecordingStartTime => (substr $rectime, 5,4). '-'.(substr $rectime, 9,2).'-'.(substr $rectime, 11,2) . ' ' .(substr $rectime, 0,2).':'.(substr $rectime, 2,2));
            
            if ($season->size() > 0){
                $writer->dataElement(SeriesNumber => $season);}
            if ($episode->size() > 0){
                $writer->dataElement(EpisodeNumber => $episode);}
            
            if ($subname->size() > 0){
                $writer->dataElement( SubTitle => $subname);
                }
            $writer->endTag('Recording');
            
           print MYFILE $output;
            close (MYFILE); 
        }
    }
 }


}


sub timestamp {
use warnings;
use strict;
 
my $time = shift;
 
die "Usage: $0 [TIME_IN_SECS_SINCE_EPOCH]\n" unless $time;
if ( length($time) > 10 ) {
    $time = substr($time, 0, 10);
}
 
my @mon  = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
my @day  = qw( Sun Mon Tue Wed Thu Fri Sat );
 
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
    = localtime($time);
 my $ret = sprintf("%02d",$hour) . sprintf("%02d",$min) . "_" . sprintf("%04d%02d%02d",$year+1900, $mon+1, $mday);
 return $ret;


}