File Coverage

blib/lib/POE/Component/Enc/Ogg.pm

Criterion	Covered	Total	%
statement	28	93	30.1
branch	3	50	6.0
condition	14	25	56.0
subroutine	6	15	40.0
pod	2	3	66.6
total	53	186	28.4

#   Ogg Vorbis encoding component for POE
#   Copyright (c) 2004 Steve James. All rights reserved.
#
#   This library is free software; you can redistribute it and/or modify
#   it under the same terms as Perl itself.
#

package POE::Component::Enc::Ogg;

use 5.008;
use strict;
use warnings;
use Carp;
use POE qw(Wheel::Run Filter::Line Driver::SysRW);

our $VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);

# Create a new encoder object
sub new {
    my $class = shift;
    my $opts  = shift;

    my $self = bless({}, $class);

    my %opts = !defined($opts) ? () : ref($opts) ? %$opts : ($opts, @_);
    %$self = (%$self, %opts);

    $self->{quality}   ||= 3;   # Default quality level of 3
    $self->{priority}  ||= 0;   # No priority delta by default

    $self->{parent}    ||= 'main';    # Default parent
    $self->{status}    ||= 'status';  # Default events
    $self->{error}     ||= 'error';
    $self->{done}      ||= 'done';
    $self->{warning}   ||= 'warning';

    return $self;
}


# Start an encoder.
sub enc {
    my $self = shift;
    my $opts = shift;

    my %opts = !defined($opts) ? () : ref($opts) ? %$opts : ($opts, @_);
    %$self = (%$self, %opts);

    croak "No input file specified" unless $self->{input};

    croak "Input file does not exist: '$self->{input}'"
      unless (-f $self->{input});

    $self->{input} =~ /(.*)\.(.*)$/;
    my ($path, $ext) = ($1, $2);

    croak "Input file extension must be 'wav' or 'flac': I have '$ext'"
      unless ($ext eq 'wav' || $ext eq 'flac');

    # Output filename is derived from input, unless specified
    unless ($self->{output}) {
        $self->{output} = "$path.ogg";
    }

    # For posting events to the parent session. Always passes $self as
    # the first event argument.
    sub post_parent {
        my $kernel = shift;
        my $self   = shift;
        my $event  = shift;

        $kernel->post($self->{parent}, $event, $self, @_)
            or carp "Failed to post to '$self->{parent}': $!";
    }

    POE::Session->create(
        inline_states => {
            _start => sub {
                my ($heap, $kernel, $self) = @_[HEAP, KERNEL, ARG0];

                $kernel->sig(CHLD => "child"); # We must handle SIGCHLD

                $heap->{self} = $self;

                my @args;   # List of arguments for encoder

                push @args, '--album="'   . $self->{album} .'"'
                    if $self->{album};

                push @args, '--genre="'   . $self->{genre} .'"'
                    if $self->{genre};

                push @args, '--title="'   . $self->{title} .'"'
                    if $self->{title};

                push @args, '--date="'    . $self->{date} .'"'
                    if $self->{date};

                push @args, '--artist="'  . $self->{artist} .'"'
                    if $self->{artist};

                push @args, '--output="'  . $self->{output} .'"';

                push @args, '--quality="' . $self->{quality} .'"'
                    if $self->{quality};

                push @args, '--tracknum="'. $self->{tracknumber}.'"'
                    if $self->{tracknumber};

                # The comment parameter is a list of tag-value pairs.
                # Each list element must be passed to the encoder as a
                # separate --comment argument.
                if ($self->{comment}) {
                    foreach (@{$self->{comment}}) {
                        push @args, '--comment="' . $_ .'"'
                    }
                }

                # Name of the encoder program we will use
                my $encoder = 'oggenc';

                # We might need to use a decoder front-end pipe
                my $decoder = '';

                # If the input is in flac format, use a flac decoder
                # front-end, and pipe it to the encoder.
                # Otherwise pass the input file name direct to the encoder
                if ($ext eq 'flac') {
                    $decoder = "flac --decode --silent --stdout $self->{input} |";
                    push @args, '-';
                } else {
                    push @args, $self->{input};
                }

                $heap->{wheel} = POE::Wheel::Run->new(
                    Program     => $decoder.$encoder,
                    ProgramArgs => \@args,
                    Priority    => $self->{priority},
                    StdioFilter => POE::Filter::Line->new(),
                    Conduit     => 'pty',
                    StdoutEvent => 'wheel_stdout',
                    CloseEvent  => 'wheel_done',
                    ErrorEvent  => 'wheel_error',
                );
            },

            _stop => sub {
            },

            close => sub {
                delete $_[HEAP]->{wheel};
            },

            # Handle CHLD signal. Stop the wheel if the exited child is ours.
            child => sub {
                my ($kernel, $heap, $signame, $child_pid, $exit_code)
                    = @_[KERNEL, HEAP, ARG0, ARG1, ARG2];

                if ($heap->{wheel} && $heap->{wheel}->PID() == $child_pid) {
                    delete $heap->{wheel};

                    # If we got en exit code, the child died unexpectedly,
                    # so create a wheel-error event. otherwise the child exited
                    # normally, so create a wheel-done event.
                    if ($exit_code) {
                        $kernel->yield('wheel_error', $exit_code);
                    } else {
                        $kernel->yield('wheel_done');
                    }
                }
            },

            wheel_stdout => sub {
                my ($kernel, $heap) = @_[KERNEL, HEAP];
                my $self = $heap->{self};
                $_ = $_[ARG0];

                if (m{^ERROR: (.*)}i) {
                    # An error message has been emitted by the encoder.
                    # Remember the message for later
                    $self->{message} = $1;
                } elsif (m{^WARNING: (.*)}i) {
                    # A warning message has been emitted by the encoder.
                    # Post the warning message to the parent
                    post_parent($kernel, $self, $self->{warning},
                                $self->{input},
                                $self->{output},
                                $1
                                );
                    return;
                } elsif (m{^
                    \s+ \[ \s+ ([0-9.]+) % \s* \]
                    \s+ \[ \s+ (\d+) m (\d+) s \s+ remaining \s* \]
                    }x) {
                    # We have a progress message from the encoder
                    # Post the percentage and number of remaining seconds
                    # to the parent.
                    my ($percent, $seconds) = ($1, $2 * 60 + $3);

                    post_parent($kernel, $self, $self->{status},
                                $self->{input},
                                $self->{output},
                                $percent, $seconds
                    );
                }
            },

            wheel_error => sub {
                my ($kernel, $heap) = @_[KERNEL, HEAP];
                my $self = $heap->{self};

                post_parent($kernel, $self, $self->{error},
                    $self->{input},
                    $self->{output},
                    $_[ARG0],
                    $self->{message} || ''
                );

                # Remove output file: might be incomplete
                $_ = $self->{output}; unlink if ($_ && -f);
            },

            wheel_done => sub {
                my ($kernel, $heap) = @_[KERNEL, HEAP];
                my $self = $heap->{self};

                # Delete the input file if instructed
                unlink $self->{input} if $self->{delete};

                post_parent($kernel, $self, $self->{done},
                    $self->{input},
                    $self->{output}
                );
            },
        },
        args => [$self]
    );
}

1;
__END__