# -----------------------------------------------------------------------------

=encoding utf8

=head1 NAME

Quiq::Smb::Client - SMB Client

=head1 BASE CLASS

L<Quiq::Hash>

=head1 DESCRIPTION

Ein Objekt der Klasse repräsentiert einen SMB-Client. Die Klasse
realisiert ihre Funktionalität unter Rückgriff auf
L<Filesys::SmbClient|https://metacpan.org/pod/Filesys::SmbClient>,
allerdings nicht durch Ableitung, sondern durch Einbettung.
Die Klasse zeichnet sich dadurch aus, dass sie

=over 2

=item *

höhere Dateioperationen wie ls(), get() und put() realisiert
(ähnlich FTP)

=item *

Fehler nicht über Returnwerte anzeigt, sondern im Fehlerfall
eine Exception wirft

=back

=cut

# -----------------------------------------------------------------------------

package Quiq::Smb::Client;
use base qw/Quiq::Hash/;

use v5.10;
use strict;
use warnings;

our $VERSION = '1.233';

use Quiq::Path;
use Quiq::Unindent;
use Filesys::SmbClient ();

# -----------------------------------------------------------------------------

=head1 METHODS

=head2 Konstruktor

=head3 new() - Instantiiere Objekt

=head4 Synopsis

  $smb = $class->new(%args);

=head4 Arguments

=over 4

=item %args

Liste von Schlüssel/Wert-Paaren, siehe
L<Filesys::SmbClient|https://metacpan.org/pod/Filesys::SmbClient#new-%hash>.

=back

=head4 Returns

Object

=head4 Description

Instantiiere eine Objekt der Klasse und liefere eine Referenz auf
dieses Objekt zurück.

Die Eigenschaft C<configuration> gehört nicht zu C<Filesys::SmbClient>,
sondern ist speziell hinzugefügt. Wenn gesetzt, wird die Datei
C<~/.smb/smb.conf> mit dem angegebenen Text (SMB-Konfiguration)
vor der Instantiierung geschrieben. Andernfalls wird eine leere
Datei angelegt. Die Konfiguration scheint nicht (einmalig) während
Konstruktoraufrufs gelesen zu werden, sondern bei späteren (der
ersten?) Operation. Daher ist Vorsicht bei mehreren Objekten
geboten (TODO: dies genauer untersuchen).

=head4 Example

  my $smb = Quiq::Smb->new(
      username => 'elbrusfse',
      password => 'geheim',
      workgroup => 'ZEPPELIN_HV',
      debug => 0, # 0 .. 10
      configuration => '
          [global]
          client min protocol = CORE
          client use spnego = no
          client ntlmv2 auth = no
      ',
  );

=cut

# -----------------------------------------------------------------------------

sub new {
    my ($class,%args) = @_;

    my $p = Quiq::Path->new;

    my $confFile = '~/.smb/smb.conf';

    my $conf = $args{'configuration'} // '';
    $conf = Quiq::Unindent->string($conf);
    $p->write($confFile,$conf);

    return $class->SUPER::new(
        smb => Filesys::SmbClient->new(%args),
    );
}

# -----------------------------------------------------------------------------

=head2 Objektmethoden

=head3 delete() - Lösche Datei von Server

=head4 Synopsis

  $smb->delete($file);

=head4 Arguments

=over 4

=item $file

(String) Pfad der Datei.

=back

=head4 Description

Lösche Datei $file von Server.

=cut

# -----------------------------------------------------------------------------

sub delete {
    my ($self,$file) = @_;

    my $smb = $self->{'smb'};

    my $ret = $smb->unlink($file);
    if (!$ret) {
        $self->throw(
            'SMB-00003: Delete failed',
            File=>qq|"$file"|,
            Error=>$!,
        );
    }
    
    return;
}

# -----------------------------------------------------------------------------

=head3 getData() - Hole Daten von Server

=head4 Synopsis

  $data = $smb->getData($file);

=head4 Arguments

=over 4

=item $file

(String) Dateiname.

=back

=head4 Returns

(String) Dateininhalt.

=head4 Description

Liefere den Inhalt der Datei $file.

=head4 Example

  $data = $smb->get('smb://ZBM-MOM-T/XRECHNUNG$/S-001191090X_Original.pdf');

=cut

# -----------------------------------------------------------------------------

sub getData {
    my ($self,$file) = @_;

    my $smb = $self->{'smb'};

    my $data;
    my $fd = $smb->open($file,'0666');
    if (!$fd) {
        $self->throw(
            'SMB-00002: Open for reading failed',
            Path=>qq|"$file"|,
            Error=>$!,
        );
    }
    while (1) {
        my $buf = $smb->read($fd);
        if (!$buf) {
            # eof
            last;
        }
        $data .= $buf;
    }
    $smb->close($fd);
    
    return $data;
}

# -----------------------------------------------------------------------------

=head3 ls() - Liste von Dateien in Server-Verzeichnis

=head4 Synopsis

  @arr|$arr = $sbm->ls($dir);

=head4 Arguments

=over 4

=item $dir

Verzeichnis

=back

=head4 Returns

(Array of Strings) Liste von Dateinamen. Im Skalarkontext eine Referenz
auf die Liste.

=head4 Description

Liefere die Liste der Dateien auf dem Server in Verzeichnis $dir.

=head4 Example

  @names = $smb->ls('smb://ZBM-MOM-T/XRECHNUNG$');

=cut

# -----------------------------------------------------------------------------

sub ls {
    my ($self,$path) = @_;

    my $smb = $self->{'smb'};

    my @arr;
    my $fd = $smb->opendir($path);
    if (!$fd) {
        $self->throw(
            'SMB-00001: ls failed',
            Path=>qq|"$path"|,
            Error=>$!,
        );
    }
    for ($smb->readdir($fd)) {
        if ($_ eq '.' || $_ eq '..') {
            next;
        }
        push @arr,$_;
    }
    $smb->closedir($fd);
    
    return wantarray? @arr: \@arr;
}

# -----------------------------------------------------------------------------

=head3 put() - Übertrage Datei auf Server

=head4 Synopsis

  $smb->put($from,$to);

=head4 Arguments

=over 4

=item $from

(String) Pfad der Quelldatei.

=item $to

(String) Pfad der Zieldatei

=back

=head4 Description

Kopiere Datei $from nach $to.

=head4 Example

  $smb->put('test.xls','smb://zeppelin.corp/zbm/Transfer/elbrusfse/test.xls');

=cut

# -----------------------------------------------------------------------------

sub put {
    my ($self,$from,$to) = @_;

    my $data = Quiq::Path->read($from);
    $self->putData($data,$to);
    
    return;
}

# -----------------------------------------------------------------------------

=head3 putData() - Übertrage Daten auf Server

=head4 Synopsis

  $smb->putData($data,$file);

=head4 Arguments

=over 4

=item $data

(String) Dateiinhalt.

=item $file

(String) Dateiname.

=back

=head4 Description

Schreibe Datei $file mit Inhalt $data.

=head4 Example

  $smb->putData($data,'smb://ZBM-MOM-T/XRECHNUNG$/S-001191090X_Original.pdf');

=cut

# -----------------------------------------------------------------------------

sub putData {
    my ($self,$data,$file) = @_;

    my $smb = $self->{'smb'};

    my $fd = $smb->open(">$file",'0666');
    if (!$fd) {
        $self->throw(
            'SMB-00002: Open for writing failed',
            Path=>qq|"$file"|,
            Error=>$!,
        );
    }
    my $ret = $smb->write($fd,$data);
    if (!$ret) {
        $self->throw(
            'SMB-00003: Write failed',
            Path=>qq|"$file"|,
            Error=>$!,
        );
    }
    $smb->close($fd);
    
    return;
}

# -----------------------------------------------------------------------------

=head3 rename() - Benenne Datei auf Server um

=head4 Synopsis

  $smb->rename($oldname,$newname);

=head4 Arguments

=over 4

=item $oldname

(String) Alter Dateiname.

=item $newname

(String) Neuer Dateiname.

=back

=head4 Description

Benenne Datei $oldname in $newname um.

=cut

# -----------------------------------------------------------------------------

sub rename {
    my ($self,$oldname,$newname) = @_;

    my $smb = $self->{'smb'};

    my $ret = $smb->rename($oldname,$newname);
    if (!$ret) {
        $self->throw(
            'SMB-00003: Rename failed',
            Path=>qq|"$oldname" => "$newname"|,
            Error=>$!,
        );
    }
    
    return;
}

# -----------------------------------------------------------------------------

=head1 VERSION

1.233

=head1 AUTHOR

Frank Seitz, L<http://fseitz.de/>

=head1 COPYRIGHT

Copyright (C) 2025 Frank Seitz

=head1 LICENSE

This code is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

# -----------------------------------------------------------------------------

1;

# eof
