package Koha::Exceptions::File;

use Modern::Perl;

use File::Basename;

use Koha::File;

use Koha::Exceptions;

use Exception::Class (

    'Koha::Exceptions::File' => {

        isa => 'Koha::Exceptions::Exception',

        description => 'Problem with a file',

        fields => ['path', 'stat'],

    },

);

=head2 throw

@OVERLOADS

Adds diagnostic information regarding the file with issues

=cut

sub throw {

    my ($self, %args) = @_;

    my @pwuid = getpwuid($<);

    my $realUser = $pwuid[0];

    @pwuid = getpwuid($>);

    my $effectiveUser = $pwuid[0];

    my $stat = 'File permissions:> ';

    if (-e $args{path}) {

        $stat .= Koha::File::getDiagnosticsString($args{path});

    }

    else {

        $stat .= "FILE NOT EXISTS.";

        my $parentDir = File::Basename::dirname($args{path});

        $stat .= " Parent directory '$parentDir' permissions:> ".(Koha::File::getDiagnosticsString(  $parentDir  ) || 'DIR NOT EXISTS');

    }

    $stat .= ", Real user:> $realUser, Effective user:> $effectiveUser";

    $args{stat} = $stat;

    $args{error} .= '. '.$stat;

    $self->SUPER::throw(%args);

}

1;

package Koha::File;

use Modern::Perl;

use Fcntl;

=head1 SYNOPSIS

This package providers helper methods to work with files

Maybe even be a wrapper in Koha for working with files some day?

=cut

our @filetypes; #Save the translation table for filetypes for global access

$filetypes[Fcntl::S_IFDIR] = "d";

$filetypes[Fcntl::S_IFCHR] = "c";

$filetypes[Fcntl::S_IFBLK] = "b";

$filetypes[Fcntl::S_IFREG] = "-";

$filetypes[Fcntl::S_IFIFO] = "p";

$filetypes[Fcntl::S_IFLNK] = "l";

$filetypes[Fcntl::S_IFSOCK] = "s";

=head2 getDiagnostics

@PARAM1 String, path to a file

@RETURNS HASHRef, file properties in clear text.

         undef, if no such file found

@THROWS nothing, do not throw from here, especially not File-exceptions,

                 because this subroutine is used in File-exception diagnostics and could cause a circular recursion when no file is found.

=cut

sub getDiagnostics {

    my ($path) = @_;

    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = lstat($path);

    return undef unless $dev; #No such file

    my %rv;

    $rv{user} =        getpwuid($uid);

    $rv{group} =       getgrgid($gid);

    $rv{permissions} = sprintf "%04o", Fcntl::S_IMODE($mode);

    $rv{filetype} =    $filetypes[ Fcntl::S_IFMT($mode) ];

    return \%rv;

}

our $diagnosticsStringFormat = '%s %s %s:%s';

sub getDiagnosticsString {

    my $stat = getDiagnostics(@_);

    return sprintf($diagnosticsStringFormat, $stat->{filetype}, $stat->{permissions}, $stat->{user}, $stat->{group});

}

1;

use Modern::Perl;

use Test::More;

use Try::Tiny;

use File::Basename;

use Koha::Exceptions::File;

#file diagnostics are more throughly tested in t/Koha/File.t

subtest "Catch File-exception and inspect diagnostics", \&getDiagnostics;

sub getDiagnostics {

    my $file = $ENV{KOHA_PATH}.'/kohaversion.pl';

    my $parentDir = File::Basename::dirname($file);

    try {

        Koha::Exceptions::File->throw(error => "error", path => $file);

        ok(0, "??Why no throw exception??");

    } catch { my $e = $_;

        ok($e->isa('Koha::Exceptions::File'), "Given the expected exception");

        like($e->stat, qr/^\w+/, "Then the file diagnostics look legit");

    };

    $file = $ENV{KOHA_PATH}.'/koha-aversion.pl';

    try {

        Koha::Exceptions::File->throw(error => "error", path => $file);

        ok(0, "??Why no throw exception??");

    } catch { my $e = $_;

        ok($e->isa('Koha::Exceptions::File'), "Given the expected exception");

        like($e->stat, qr/^\w+/, "Then the file diagnostics look legit");

        like($e->stat, qr/FILE NOT EXISTS/, "And file doesn't exist");

        like($e->stat, qr/Parent directory '$parentDir' permissions/, "And parent directory diagnostics delivered");

    };

}

done_testing;