#!/usr/bin/perl
#############################################################################
#
# rx_* dispatcher and handlers for VFU File Manager
# Copyright (c) 2002-2020 Vladi Belperchinov-Shabanski "Cade" 
# <cade@biscom.net> <cade.datamax.bg>
#
# usage:
#   rx_* l archive directory   # list archive directory
#   rx_* v archive             # list entire archive
#   rx_* x archive files...    # extract one file
#   rx_* x archive @listfile   # extract list of files
#
#############################################################################
use strict;

umask 0077;

my $cmd = lc shift @ARGV;
my $archive = shift @ARGV;
my $ac=`ar t "$archive"`;

die "unsupported DEB package\n" unless $ac =~ /(data.tar.[a-z0-9]+)/;
my $data = $1;

my $cache = "$archive.$data.rx.cache";
$cache =~ s/^(.+)\/([^\/]+)$/$2/;

if( $cmd eq "l" || $cmd eq "v" || $cmd eq "x" )
   {
   if( ! -e "/tmp/$cache" )
     {
     # cache not found--fill it
     system( qq[ umask 0077 ; ar p "$archive" $data > "/tmp/$cache\" ] );
     }
   else
     {
     utime time(), time(), "/tmp/$cache"; # update last modification time of the cache
     }
  if( $cmd eq 'x' )
    {
    for( @ARGV )
      {
      if( /^\@(.+)/ )
        {
        fix_list_names( $1 );
        }
      else
        {
        s/^(?!\.\/)/.\//;
        }  
      }
    }
  system( "/usr/libexec/vfu/rx_tar", $cmd, "/tmp/$cache", @ARGV );
  }
else
  {
  die $0 . ": wrong command.\n";
  }


sub fix_list_names
{
  my $fn  = shift; # file name
  my @l = file_load_ar( $fn );
  s/^(?!\.\/)/.\// for @l;
  file_save( $fn, @l );
  return 1;
}

sub file_load_ar
{
  my $fn  = shift; # file name
  open( my $i, "<", $fn ) or return undef;
  my @all = <$i>;
  close $i;
  return @all;
}

sub file_save
{
  my $fn = shift; # file name
  
  open( my $o, ">", $fn ) or return 0;
  print $o @_;
  close $o;
  return 1;
}
