cbrz2pdfz - an example of porting Bash to Raku

cbrz2pdfz.raku

#!/usr/bin/env raku

subset ValidDirectory of IO::Path() where *.d;

subset ExistingFile of IO::Path() where *.e;
subset ComicBookFile of ExistingFile where *.extension eq 'cbz'|'cbr';

subset NonexistentFile of IO::Path() where not *.e;
subset OutputFile where *.extension eq 'pdf';

subset ZeroToOneHundred where 0 <= * <= 100;
subset Geometry where -> $geo {
    $geo.comb.tail eq "%" || $geo.split('x').elems == 2
}

enum Stage <Queue Extract Convert BatchConvert Clean>;
enum StageStatus <Begin Success Failure>;
enum NotifyType <Simple Verbose>;

class ConversionPipeline { ... }
class ConversionPipeline::RangedPart { ... }
role Notification::Packet { ... }


sub MAIN(
    IO::Path()       :i(:$input),        #= Input Directory (required)
    IO::Path()       :o(:$output),       #= Output Directory (required)
    IO::Path()       :$parts,            #= A file with parts and part ranges specified
    Int()            :p(:$parallel) = 1, #= Parallelism
                                         ## TODO: Current version using imagemagick causes EOM pretty frequently even for p=2)
    ZeroToOneHundred :$quality = 77,     #= Quality (0 = most compression, 100 = least compression)
    Geometry         :$resize  = "66%",  #= Resize  ('1' - '100%+' resize percentage or 'XxY' fully specified geometry)
    Bool             :$verbose = False,
    NotifyType       :$notify-type = $verbose ?? NotifyType::Verbose !! NotifyType::Simple,
    Bool             :$auto-cover  = True
) {
    # Setup ad-hoc notify
    my sub notify(*@args) { Notification::notify(|@args) };

    # Check for presence of magick
    die "Need to have ImageMagick installed" unless q:x[ which magick ];

    multi sub wrangle-output-path(ComicBookFile $cbf, Str:D $part-name) {
        wrangle-output-path($cbf).parent.add: $part-name ~ '.pdf'
    }
    multi sub wrangle-output-path(ComicBookFile $cbf) {
        # We always have a "root" input folder.
        # TODO: Support the Windoze

        my $parent-path = common-parent-path $cbf;
        my $output-path = $parent-path.add: $output.add: $cbf.extension('pdf').subst($parent-path,'').IO;

        $output-path
    }

    sub extraction(ConversionPipeline $pipeline --> Promise) {
        return Promise.kept if $pipeline.extraction-dir.d;
        start {
            notify $pipeline, Extract, Begin, $notify-type;

            my $process = Proc::Async.new: '7z', 'x', $pipeline.source.Str, "-o{$pipeline.extraction-dir}";
            $process.stdout.tap: -> $ignore {};
            my @errors;
            $process.stderr.tap: -> $error { @errors.push: $error };

            my $result = await $process.start;
            my $status = $result.exitcode == 0 ?? Success !! Failure;
            say @errors.join("\n")
                if $status == Failure && @errors;

            notify $pipeline, Extract, $status, $notify-type;
            $pipeline
        }
    }

    sub common-parent-path($source) {
        my @src = $source.IO.absolute.Str.comb;
        my @out = $output.IO.absolute.comb;

        my $parent;
        while @src.shift eq my $c = @out.shift {
            $parent ~= $c
        }

        $parent.IO
    }

    sub conversion(ConversionPipeline $pipeline, Stage \stage = Convert --> Promise) {
        start {
            notify $pipeline, stage, Begin, $notify-type;

            my $extracted-cb = $pipeline.extraction-dir.dir.grep(*.d).first || $pipeline.extraction-dir;

            my @images = $extracted-cb.dir(test => /'.jpg' $/).sort;
            @images  ||= $extracted-cb.dir(test => /'.jpeg' $/).sort;
            @images  ||= $extracted-cb.dir(test => /'.png' $/).sort;

            if my $ranged-pipeline = $pipeline ~~ ConversionPipeline::RangedPart {
                @images = $auto-cover ?? @images[0] !! Empty,   # Cover
                          |@images[|$pipeline.front],
                          |@images[$pipeline.start..$pipeline.end];

                @images .= grep: *.IO.e;
            }

            my $process = Proc::Async.new:
                            'magick',   @images,
                                        '-strip',
                                        '-interlace', 'Plane',
                                        '-gaussian-blur', '0.05',
                                        '-quality', $quality,
                                        '-resize', $resize,
                                        '-define', qq[ registry:temporary-path=$pipeline.extraction-dir.parent.add('magick-pipeline') ],
                                        '-limit', 'memory', '16mb',
                                        $pipeline.output.Str;

            my $result = await $process.start;
            my $status = $result.exitcode ?? Failure !! Success;

            notify $pipeline, stage, $status, $notify-type;
            $pipeline
        }
    }

    sub process(@cb --> Promise) {
        my $run = Promise.new;
        start {
            my Supplier $extract-supplier  = Supplier.new;
            my Supply   $extract-processor = $extract-supplier.Supply;

            my Supplier $convert-supplier  = Supplier.new;
            my Supply   $convert-processor = $convert-supplier.Supply;

            my Supplier $clean-supplier    = Supplier.new;
            my Supply   $clean-processor   = $clean-supplier.Supply;

            my %extraction-dirs;

            $extract-processor.act: -> $pipeline {
                if $pipeline.defined {
                    if not $pipeline.output.e {
                        $pipeline.extraction-dir.d
                                        ?? $convert-supplier.emit: $pipeline
                                        !! $convert-supplier.emit: await extraction($pipeline);
                    }
                } else { # Pass the canary
                    $convert-supplier.emit: $pipeline
                }
            };
            $convert-processor.act: -> $p {
                if $p {
                    my $stage = $p ~~ ConversionPipeline::RangedPart ?? BatchConvert !! Convert;
                    await conversion($p, $stage);
                    %extraction-dirs{$p.extraction-dir} //= $p;
                } else {
                    $clean-supplier.emit: %extraction-dirs
                }
            };
            $clean-processor.act: -> %extraction-dirs {
                state %already-extracted;
                for %extraction-dirs.values -> $p {
                    next if %already-extracted{$p.extraction-dir};

                    notify $p, Clean, Begin, $notify-type;
                    my $status = $p.clean ?? Success !! Failure;
                    notify $p, Clean, $status, $notify-type;

                    %already-extracted{$p.extraction-dir} = True;
                }
                $run.keep(Success);
            };

            CATCH {
                .say;
                $run.keep(Failure)
            }

            for @cb -> $source {
                $extract-supplier.emit: $source;
            }
        }
        $run
    }

    my %parts = $parts && $parts.e ?? $parts.slurp.EVAL !! %();

    my @cb-files;
    my @todo = $input;
    my @skipped-paths;
    while @todo.pop -> $this-todo {
        for $this-todo.dir -> $source {
            if $source ~~ ComicBookFile {
                if %parts{$source.basename} -> @parts {
                    @cb-files.push: |@parts.map: -> $part {
                        ConversionPipeline::RangedPart.new: :$source, :$resize, :$quality,
                                                            :start($part<start>), :end($part<end>), :front($part<front> // []),
                                                            :output(wrangle-output-path($source, $part<name>))
                    }
                } else {
                    my $pipeline = ConversionPipeline.new:  :$source, :$resize, :$quality,
                                                            :output(wrangle-output-path($source));
                    # Boolean logic is weird, so I use the loosest precedent form of negaation.
                    # Half the time I think this is awesome, half the time I feel like it's
                    # confusing.
                    @cb-files.push: $pipeline;
                }
            }
            @todo.push($source) if $source ~~ ValidDirectory;
        }
    }
    return unless @cb-files;

    @cb-files .= push: ConversionPipeline;

    await @cb-files.rotor(@cb-files.elems / $parallel, :partial)
                   .grep({ .defined })
                   .map({ |@^cb, ConversionPipeline }) # Add canary values to signal the end of the pipelines
                   .map({ process(@^cb) });
}


# Helper classes
class ConversionPipeline {
    #| Note that having ComicBookFile here allows us to safely interpolate this source
    has ComicBookFile $.source is required;
    has OutputFile    $.output is required;

    has $.resize is required;
    has $.quality is required;

    method name             { $!source.extension('').basename };
    # TODO: Move management of dir creation here
    method extraction-dir               { $!output.extension('') }

    method clean {
        return True unless self.extraction-dir.d;
        so not run('rm', '-rf', self.extraction-dir.Str).exitcode
    }
}

class ConversionPipeline::RangedPart {
    also is ConversionPipeline;

    has Int $.start is required;
    has Int $.end is required;
    has Int @.front = [];

    method extraction-dir { self.output.parent.add: self.name }
}

# TODO: Remember how to load/import modules from the same
module Notification {
    role Packet[NotifyType $type = Simple] {
        has ConversionPipeline $.pipeline is required;
        has Stage $.stage is required;
        has StageStatus $.status is required;
        method type { $type }
    }

    subset Notification::Simple  of Packet where *.type == Simple;
    subset Notification::Verbose of Packet where *.type == Verbose;
    subset Conversion of Packet where *.stage == Convert;
    subset BatchConversion of Packet where *.stage == BatchConvert;

    my Supplier $notify-supplier  = Supplier.new;
    my Supply   $notify-processor = $notify-supplier.Supply;
    NOTIFY-SETUP: {
        $notify-processor.act: -> Packet $n { handle-notification($n) }
    }

    our proto sub handle-notification(|) {*}
    our multi sub handle-notification(Notification::Simple $n where Conversion) {
        say qq| $n.pipeline.name()\t///Stage:[$n.stage()\@R:<$n.pipeline.resize()>/Q:<$n.pipeline.quality()>=\t$n.status()}] |
    }

    our multi sub handle-notification(Notification::Simple $n) {
        say qq| $n.pipeline.name()\t///Stage:[$n.stage()::$n.status()] |
    }
    our multi sub handle-notification(Notification::Verbose $n where BatchConversion) {
        say qq:to/EOM/;
            Pipeline[ $n.pipeline.name() | $n.pipeline.output.basename() ]:
                Source:  $n.pipeline.source()
                Output:  $n.pipeline.output()
                ---
                Stage | Status:  [ $n.stage() | $n.status.uc() ]
                Image Directory: $n.pipeline.extraction-dir()
                ---
                Quality: $n.pipeline.quality()
                Resize:  $n.pipeline.resize()
        EOM
    }
    our multi sub handle-notification(Notification::Verbose $n where Conversion) {
        # TODO: Add some cool TUI monitoring / test harness / etc
        say qq:to/EOM/;
            Pipeline[ $n.pipeline.name() ]
            Status  [ $n.status.uc() ]
                Source:  $n.pipeline.source()
                Output:  $n.pipeline.output()
                ---
                Stage | Status:  [ $n.stage() | $n.status.uc() ]
                Image Directory: $n.pipelitne.extraction-dir()
                ---
                Quality: $n.pipeline.quality()
                Resize:  $n.pipeline.resize()
        EOM
    }
    our multi sub handle-notification(Notification::Verbose $n) {
        # TODO: Add some cool TUI monitoring / test harness / etc
        say qq:to/EOM/;
            Pipeline[ $n.pipeline.name() ]
            Status  [ $n.status.uc() ]
                Source:  $n.pipeline.source()
                Output:  $n.pipeline.output()
                ---
                Stage | Status:  [ $n.stage() | $n.status.uc() ]
                ---
                Extraction Directory: $n.pipeline.extraction-dir()
        EOM
    }


    # TODO: Make this a multi, support TUI interface and testing
    our sub notify(ConversionPipeline $pipeline, Stage $stage, StageStatus $status, NotifyType $type = Verbose) {
        $notify-supplier.emit: Notification::Packet[$type].new: :$pipeline, :$stage, :$status;
    }
}