File Coverage

blib/lib/meon/Web/Util.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package meon::Web::Util;

use Text::Unidecode 'unidecode';
use Path::Class 'dir', 'file';
use XML::LibXML::XPathContext;
use Carp 'croak';
use Run::Env;
use Email::MIME;
use Email::Sender::Simple qw(sendmail);
use File::MimeInfo 'mimetype';

sub xpc {
    my $xpc = XML::LibXML::XPathContext->new;
    $xpc->registerNs('x', 'http://www.w3.org/1999/xhtml');
    $xpc->registerNs('w', 'http://web.meon.eu/');
    return $xpc;
}

sub filename_cleanup {
    my ($self, $text) = @_;
    $text = unidecode($text);
    $text =~ s/\s/-/g;
    $text =~ s/-+/-/g;
    $text =~ s/[^A-Za-z0-9\-_]//g;
    return $text;
}

sub username_cleanup {
    my ($self, $username, $folder) = @_;

    $username = unidecode($username);
    $username =~ s/[^A-Za-z0-9]//g;
    while (length($username) < 4) {
        $username .= 'x';
    }

    my $base_username = $username;
    my $i = 1;
    while (-d dir($folder, $username)) {
        $i++;
        my $suffix = sprintf('%02d', $i);
        $username = $base_username.$suffix;
    }

    return $username;
}

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

    my $username = (
        meon::Web::env->user
        ? $username = meon::Web::env->user->username
        : 'anonymous'
    );

    $path =~ s/{\$USERNAME}/$username/;

    if ($path =~ m/^(.*){\$TIMELINE_NEWEST}/) {
        my $base_dir = dir(meon::Web::env->current_dir, (defined($1) ? $1 : ()));
        my $dir = $base_dir;
        while (my @subfolders = sort grep { $_->basename =~ m/^\d+$/ } grep { $_->is_dir } $dir->children(no_hidden => 1)) {
            $dir = pop(@subfolders);
        }
        $dir = $dir->relative($base_dir);
        $dir .= '';
        $path =~ s/{\$TIMELINE_NEWEST}/$dir/;
    }

    if ($path =~ m/{\$COMMENT_TO}/) {
        my $comment_to = meon::Web::env->stash->{comment_to};
        $path =~ s/{\$COMMENT_TO}/$comment_to/;
    }

    return $path;
}

sub full_path_fixup {
    my ($self, $path) = @_;
    $path = $self->path_fixup($path);
    my $cur_dir = meon::Web::env->current_dir;
    $cur_dir = meon::Web::env->content_dir
        if $path =~ m{^/};
    $path = file($cur_dir, $path)->absolute;
}

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

    my $from    = $args{from} // croak 'need from';
    my $to      = $args{to} // croak 'need to';
    my $bcc     = $args{bcc};
    my $subject = $args{subject} // croak 'need subject';
    my $text    = $args{text} // croak 'need text';
    my @attachments = @{ $args{attachments} // [] };

    my @email_headers = (
        header_str => [
            From    => $from,
            To      => $to,
            ($bcc && !Run::Env->prod ? (Bcc => $bcc) : ()),
            Subject => $subject,
        ],
    );
    my @email_text = (
        attributes => {
            content_type => "text/plain",
            charset      => "UTF-8",
            encoding     => "8bit",
        },
        body_str => $text,
    );

    my $email;
    if (@attachments) {
        $email = Email::MIME->create(
            @email_headers,
            parts => [
                Email::MIME->create(@email_text),
                (
                    map {
                        my $filename = file(
                            ref($_) eq 'HASH'
                            ? $_->{filename}
                            : $_
                        );
                        my $basename = $filename->basename;
                        my $content_type = (
                            ref($_) eq 'HASH'
                            ? $_->{content_type}
                            : undef
                        ) // mimetype($basename) // 'application/octet-stream';
                        Email::MIME->create(
                            attributes => {
                                filename     => $basename,
                                content_type => $content_type,
                                encoding     => "base64",
                                name         => $basename,
                            },
                            body => IO::Any->slurp($filename),
                        );
                    } @attachments
                ),
            ],
        );
    }
    else {
        $email = Email::MIME->create(
            @email_headers,
            @email_text,
        );
    }

    if (Run::Env->prod) {
        sendmail($email->as_string, { to => $bcc })
            if $bcc;
        sendmail($email->as_string);
    }
    else {
        warn $email->as_string;
    }
}

1;