#!/usr/bin/perl
###################################################################################################
# Loewe DR+ folder listing
# By Campacasa (Peter Kamphuis, linux[at]campacasa[dot]eu) - Copyleft 2012-2025
#
# This utility can be freely used and modified.  In case of modifications, I'd appreciate if my
# name is kept as original reference (and you maybe let me know about any improvements).
# Feedback is welcome, too.
#
# Last modification: 04-Jul-2025
###################################################################################################
use strict;
use warnings;
use Encode;
use File::Basename;
use File::Glob qw(:bsd_glob); # to avoid file globbing to split on whitespace
use Getopt::Std;
use Term::ReadKey;
use POSIX qw(locale_h); # to sort alphabetically (working on Perl-internal encoding!)
use locale;
setlocale(LC_COLLATE,'en_US.utf8');
setlocale(LC_CTYPE,'en_US.utf8');
#--------------------------------------------------------------------------------------------------
# Command line options
my $prog = basename($0);
my $usage = "Usage: $prog [-dfhlW] [path...]\n".
            "\t-d\tShow (useless?) duplicate title information.\n".
            "\t-f\tSort by *.DAT files instead of by virtual folder (if present) and title.\n".
            "\t\tThis should be the chronological order of recordings.\n".
            "\t-h\tShow this help.\n".
            "\t-l\tShow long output.\n".
            "\t-W\tNo wrapping of long lines.\n".
            "\tPath defaults to \".\" and is expected to contain *.DAT files.\n".
            "\t*.DAT files can also be specified explicitly.\n".
            "Example:\n".
            "\tloewe_ls -l /mnt/Video\\ DR+/\n";
my %opts = ();
unless ( getopts('dfhlW',\%opts) ) {
  print STDERR $usage;
  exit 1;
}
if ( $opts{h} ) {
  print $usage;
  exit 0;
}
#--------------------------------------------------------------------------------------------------
# Get files
my @files = ();
@ARGV = ('.') unless @ARGV;
while ( @ARGV ) {
  my $arg = shift;
  $arg =~ s/\/$//;
  # *.ERR files can also exist instead of *.DAT
  if ( -d $arg ) {
    opendir D,$arg;
    foreach ( sort(readdir D) ) {
      next unless $_ =~ /\d{8}.(DAT|ERR)$/;
      push @files,"$arg/$_";
    }
    closedir D;
  } elsif ( $arg =~ /\d{8}.(DAT|ERR)$/ ) {
    push @files,$arg;
  }
}
unless ( @files ) {
  print STDERR $usage;
  exit 1;
}
#--------------------------------------------------------------------------------------------------
# Collect info
my $info = {};
file_lp: foreach my $file ( @files) {
  open F,'<',$file;
  binmode F;
  my $c = undef;
  # DATE/TIME
  seek F,0x27,0;
  $info->{$file}->{date} = undef;
  read F,$info->{$file}->{date},3;
  $info->{$file}->{date} = sprintf "20%02x/%02x/%02x",ord(substr($info->{$file}->{date},0,1)),
                                                      ord(substr($info->{$file}->{date},1,1)),
                                                      ord(substr($info->{$file}->{date},2,1));
  seek F,0x2a,0;
  $info->{$file}->{timefrom} = undef;
  read F,$info->{$file}->{timefrom},2;
  my $t1 = ord(substr($info->{$file}->{timefrom},0,1));
  my $t2 = ord(substr($info->{$file}->{timefrom},1,1));
  my $minfrom = 60 * sprintf("%x",$t1) + sprintf("%x",$t2);
  $info->{$file}->{timefrom} = sprintf "%02x:%02x",$t1,$t2;
  seek F,0x2f,0;
  $info->{$file}->{timeto} = undef;
  read F,$info->{$file}->{timeto},2;
  $t1 = ord(substr($info->{$file}->{timeto},0,1));
  $t2 = ord(substr($info->{$file}->{timeto},1,1));
  my $minto = 60 * sprintf("%x",$t1) + sprintf("%x",$t2);
  $info->{$file}->{timeto} = sprintf "%02x:%02x",$t1,$t2;
  # Compute duration
  my $mindur = 0;
  if ( $minto < $minfrom ) {
    $mindur = 24 * 60 - $minfrom + $minto;
  } else {
    $mindur = $minto - $minfrom;
  }
  $info->{$file}->{duration} = sprintf("%02d:%02d",int($mindur/60),$mindur % 60);
  # CHAIN
  seek F,0x3e,0;
  $info->{$file}->{chain} = '';
  while ( ($c = getc F) ne chr(0) ) {
    $info->{$file}->{chain} .= $c;
  }
  # TITLE
  seek F,0x6e,0;
  my $tmptitle = '';
  while ( ($c = getc F) ne chr(0) ) {
    $tmptitle .= $c;
  }
  $info->{$file}->{title} = decode('UTF-8',$tmptitle); # Perl-internal encoding for correct sorting
  $info->{$file}->{title} =~ s/\s+$//; # remove white space at end
  # TYPE
  seek F,0xbc,0;
  $info->{$file}->{type} = '';
  while ( ($c = getc F) ne chr(0) ) {
    $info->{$file}->{type} .= $c;
  }
  # LANGUAGES
  $info->{$file}->{languages} = [];
  foreach my $lc ( 0..7 ) {
    # Max. 8 languages, 64 byte fields each
    seek F,0xfe + $lc * 64,0;
    my $l3 = undef;
    last unless read F,$l3,3; # read 3 char language
    last if substr($l3,0,1) eq chr(0); # no 3 char language read
    my $lang = '';
    while ( ($c = getc F) ne chr(0) ) {
      $lang .= $c;
    }
    push @{$info->{$file}->{languages}},"$l3:$lang";
  }
  # SUBTITLES
  $info->{$file}->{subtitles} = [];
  foreach my $sc ( 0..5 ) {
    # Max. 6 subtitles, 64 byte fields each
    seek F,0x2fe + $sc * 64,0;
    my $s3 = undef;
    last unless read F,$s3,3; # read 3 char subtitle language
    last if substr($s3,0,1) eq chr(0); # no 3 char subtitle language read
    seek F,5,1; # 3 char subtitle language takes 8 bytes
    my $subtitle = '';
    while ( ($c = getc F) ne chr(0) ) {
      $subtitle .= $c;
    }
    push @{$info->{$file}->{subtitles}},"$s3:$subtitle";
  }
  # TELETEXT SUBTITLES
  $info->{$file}->{teletext} = [];
  foreach my $tc ( 0..15 ) {
    # Max. 16 teletext subtitles, 32 byte fields each(?)
    seek F,0x47e + $tc * 32,0;
    my $t3 = undef;
    last unless read F,$t3,3; # read 3 char subtitle language
    last if substr($t3,0,1) eq chr(0); # no 3 char subtitle language read
    seek F,2,1; # ignore first 5 characters
    my $teletext = '';
    while ( ($c = getc F) ne chr(0) ) {
      $teletext .= $c;
    }
    push @{$info->{$file}->{teletext}},"$t3:$teletext";
  }
  # DUPLICATE TITLE 2
  seek F,0x7be,0;
  $info->{$file}->{title_dup2} = '';
  while ( ($c = getc F) ne chr(0) ) {
    $info->{$file}->{title_dup2} .= $c;
  }
  $info->{$file}->{title_dup2} =~ s/\s+$//; # remove white space at end
  # DUPLICATE TITLE
  seek F,0x76e,0;
  $info->{$file}->{title_dup} = '';
  while ( ($c = getc F) ne chr(0) ) {
    $info->{$file}->{title_dup} .= $c;
  }
  $info->{$file}->{title_dup} =~ s/\s+$//; # remove white space at end
  # TITLE 2
  seek F,0xc10,0;
  my $tmptitle2 = '';
  while ( ($c = getc F) ne chr(0) ) {
    $tmptitle2 .= $c;
  }
  $tmptitle2 =~ s/\s+$//; # remove white space at end
  $info->{$file}->{title2} = decode('UTF-8',$tmptitle2);# Perl-internal encoding for correct sorting
  # DESCRIPTION (with optional part 2)
  seek F,0xd10,0;
  $info->{$file}->{descr} = '';
  while ( ($c = getc F) ne chr(0) ) {
    $info->{$file}->{descr} .= $c;
  }
  seek F,0x15ec,0;
  while ( ($c = getc F) ne chr(0) ) {
    $info->{$file}->{descr} .= $c;
  }
  $info->{$file}->{descr} =~ s/\s+$//; # remove white space at end
  # Remove TITLE 2 if (partial) duplicate of DESCRIPTION; e.g. happening at TV5monde
  if ( length($tmptitle2) && $info->{$file}->{descr} =~ /$tmptitle2/m ) {
    $info->{$file}->{title2} = '';
  }
  # FOLDER
  seek F,0x4258,0;
  $info->{$file}->{folder} = '';
  while ( $c = getc F ) {
    last if $c eq chr(0);
    $info->{$file}->{folder} .= $c;
  }
  # End
  close F;
} # file_lp
#--------------------------------------------------------------------------------------------------
# Output
my $nrfiles = scalar(keys(%$info));
my $cnt = 0;
# Line wrapping depending on terminal width for description
my @term = GetTerminalSize; # from Term::ReadKey
my $linelength = $term[0];
if ( $opts{f} ) {
  # Sorted by .DAT file
  foreach my $file ( sort(keys(%$info)) ) {
    # Back from Perl-internal encoding for output
    $info->{$file}->{title} = encode('UTF-8',$info->{$file}->{title});
    $info->{$file}->{title2} = encode('UTF-8',$info->{$file}->{title2});
    if ( $opts{l} ) {
      $cnt++;
      &longOutput($file);
      print "-" x $linelength,"\n" unless $cnt == $nrfiles;
    } else {
      my $filebase = basename($file,'.DAT');
      my $title = $info->{$file}->{title};
      $title = "$info->{$file}->{chain}: $info->{$file}->{date} $info->{$file}->{timefrom}"
        unless length($title);
      $title .= "; $info->{$file}->{title2}" if length($info->{$file}->{title2});
      print "$filebase: ".&wrapText($title,length($filebase)+2)."\n";
    }
  }
} else {
  # Sorted by folder/title/title2
  my $titles = {};
  foreach my $file ( keys(%$info) ) {
    $titles->{$info->{$file}->{folder}.$info->{$file}->{title}.$info->{$file}->{title2}} = $file;
  }
  foreach my $title ( sort(keys(%$titles)) ) {
    my $file = $titles->{$title};
    # Back from Perl-internal encoding for output
    $info->{$file}->{title} = encode('UTF-8',$info->{$file}->{title});
    $info->{$file}->{title2} = encode('UTF-8',$info->{$file}->{title2});
    if ( $opts{l} ) {
      $cnt++;
      &longOutput($file);
      print "-" x $linelength,"\n" unless $cnt == $nrfiles;
    } else {
      my $indent = 0;
      if ( length($info->{$file}->{folder}) ) {
        $indent = length($info->{$file}->{folder})+4;
        print "$info->{$file}->{folder} -> ";
      }
      my $title = $info->{$file}->{title};
      $title = "$info->{$file}->{chain}: $info->{$file}->{date} $info->{$file}->{timefrom}"
        unless length($title);
      $title .= "; $info->{$file}->{title2}" if length($info->{$file}->{title2});
      $title .= " [".basename($file,'.DAT')."]";
      print &wrapText($title,$indent)."\n";
    }
  }
}
#--------------------------------------------------------------------------------------------------
# End
exit 0;

#==================================================================================================
# Subroutines
sub longOutput($) {
  my $file = shift;
  # Transport stream directory
  my $dir = sprintf("%s/~%s",dirname($file),basename($file,'.DAT'));
  $dir = sprintf("%s/%s",dirname($file),basename($file,'.DAT')) unless -d $dir;
  $dir = sprintf("%s/%s",dirname($file),basename($file,'.ERR')) unless -d $dir;
  $dir = 'UNKNOWN' unless -d $dir;
  # Overall size of transport stream files
  my $size = 0;
  if ( -d $dir ) {
    my $cnt = 0;
    my @tsfiles = glob("$dir/*.trp");
    unless ( scalar(@tsfiles) ) {
      @tsfiles = glob("$dir/*");
      @tsfiles = grep(/\d{8}(\.\d{3})?$/,@tsfiles);
    }
    foreach my $trp ( @tsfiles ) {
      $cnt++;
      my @stat = stat("$trp");
      $size += $stat[7];
    }
    if ( $size > 0 ) {
      $size /= (1024 * 1024); # size in MB
      my $plural = $cnt == 1 ? '' : 's';
      $size = sprintf("%d MiB (%d transport stream file%s)",$size,$cnt,$plural);
    } else {
      $size = 'UNKNOWN';
    }
  } else {
    $dir = 'UNKNOWN';
  }
  if ( $opts{f} ) {
    # Show this first when sorting on *.DAT files
    print "FILE:      \"$file\"\n";
    print "VIDEO DIR: \"$dir/\"\n";
  }
  # Output (11 is length of left hand side fields)
  print  "FOLDER:    $info->{$file}->{folder}\n";
  print  "TITLE:     ".&wrapText($info->{$file}->{title},11)."\n";
  if ( $opts{d} ) {
    print  "TITLE_DUP: ".&wrapText($info->{$file}->{title_dup},11)."\n";
    print  "TITLE_DUP2:".&wrapText($info->{$file}->{title_dup2},11)."\n";
  }
  print  "TITLE2:    ".&wrapText($info->{$file}->{title2},11)."\n";
  print  "DATE:      $info->{$file}->{date} $info->{$file}->{timefrom} - $info->{$file}->{timeto} ".
         "($info->{$file}->{duration})\n";
  print  "CHAIN:     $info->{$file}->{chain}\n";
  print  "TYPE:      $info->{$file}->{type}\n";
  printf "LANGUAGE:  ".&wrapText(join(', ',@{$info->{$file}->{languages}}),11)."\n";
  printf "SUBTITLE:  ".&wrapText(join(', ',@{$info->{$file}->{subtitles}}),11)."\n";
  printf "TELETEXT:  ".&wrapText(join(', ',@{$info->{$file}->{teletext}}),11)."\n";
  print  "DESCR:     ".&wrapText($info->{$file}->{descr},11)."\n";
  unless ( $opts{f} ) {
    # Show this last when not sorting on *.DAT files
    print "FILE:      \"$file\"\n";
    print "VIDEO DIR: \"$dir/\"\n";
  }
  print  "SIZE:      $size\n";
  return 0;
} # sub longOutput

sub wrapText($) {
  my $txt = shift;
  my $indent = shift;
  # Wrapping or not?
  return $txt if $opts{W};
  my $width = $linelength - $indent; # max. text line length
  my $txt2 = '';
  my $ix = 0;
  while ( $ix != $[ - 1 ) {
    $ix = index $txt,"\n";
    if ( $ix > $[ - 1 && $ix < $width ) {
      $txt2 .= substr($txt,$[,$ix)."\n".(' ' x $indent);
      $txt = substr $txt,$ix + 1;
      next;
    }
    last if length($txt) <= $width;
    $ix = rindex $txt,' ',$width;
    $ix = index $txt,' ',$width + 1 if $ix == $[ - 1;
    last if $ix == $[ - 1;
    $txt2 .= substr($txt,$[,$ix)."\n".(' ' x $indent);
    $txt = substr $txt,$ix + 1;
  }
  $txt2 .= $txt;
  return $txt2;
} # sub wrapText

#==================================================================================================
# EoF vim:et:sw=2