PageRenderTime 166ms CodeModel.GetById 30ms app.highlight 103ms RepoModel.GetById 28ms app.codeStats 0ms

/lib/Teto/Track.pm

http://github.com/motemen/Teto
Perl | 455 lines | 364 code | 77 blank | 14 comment | 24 complexity | 8943c22b5a5680ecaa453c6a60e82cf3 MD5 | raw file
  1package Teto::Track;
  2use Mouse;
  3use MouseX::Types::URI;
  4use AnyEvent;
  5use AnyEvent::Util;
  6use AnyEvent::HTTP;
  7use AnyEvent::Handle;
  8use Coro;
  9# use Coro::LWP; # load in teto.pl
 10use Coro::AIO;
 11use Coro::Timer ();
 12use LWP::UserAgent;
 13use HTTP::Request::Common;
 14use Class::Load;
 15use Path::Class;
 16use File::Temp ();
 17use Cache::LRU::Peekable;
 18use Scalar::Util qw(refaddr weaken);
 19
 20use overload '""' => 'as_string', fallback => 1;
 21
 22with 'Teto::Role::Log';
 23
 24has url => (
 25    is  => 'rw',
 26    isa => 'URI',
 27    required => 1,
 28    coerce   => 1,
 29);
 30
 31has media_url => (
 32    is  => 'rw',
 33    isa => 'Maybe[Str]', # Maybe[URI]
 34    coerce => 1,
 35    lazy_build => 1,
 36);
 37
 38has title => (
 39    is  => 'rw',
 40    isa => 'Maybe[Str]',
 41);
 42
 43has image => (
 44    is  => 'rw',
 45    isa => 'Maybe[Str]',
 46);
 47
 48has user_agent => (
 49    is  => 'rw',
 50    isa => 'LWP::UserAgent',
 51    default => sub { LWP::UserAgent->new(show_progress => 1) }
 52);
 53
 54has error => (
 55    is  => 'rw',
 56    isa => 'Str',
 57);
 58
 59has buffer_signal => (
 60    is  => 'rw',
 61    isa => 'Coro::Signal',
 62    default => sub { Coro::Signal->new },
 63);
 64
 65before error => sub {
 66    my $self = shift;
 67    if (@_) {
 68        $self->log(error => @_);
 69        $self->done;
 70    }
 71};
 72
 73### Track status
 74
 75use constant {
 76    TRACK_STATUS_STANDBY => 'standby',
 77    TRACK_STATUS_PLAYING => 'playing',
 78    TRACK_STATUS_DONE    => 'done',
 79};
 80
 81has status => (
 82    is  => 'rw',
 83    isa => 'Str',
 84    default => 'standby',
 85);
 86
 87sub is_standby {
 88    my $self = shift;
 89    return 1 if not $self->has_buffer;
 90    return 1 if $self->status eq TRACK_STATUS_STANDBY;
 91    return 0;
 92}
 93
 94sub is_playing {
 95    my $self = shift;
 96    return 0 unless $self->status eq TRACK_STATUS_PLAYING;
 97    return 0 unless $self->has_buffer;
 98    return 1;
 99}
100
101sub is_done {
102    my $self = shift;
103    return 0 unless $self->status eq TRACK_STATUS_DONE;
104    return 0 unless $self->has_buffer;
105    return 1;
106}
107
108sub done {
109    my $self = shift;
110    $self->status(TRACK_STATUS_DONE);
111    # $self->log(debug => 'broadcast buffer_signal');
112    $self->buffer_signal->broadcast;
113}
114
115__PACKAGE__->meta->make_immutable;
116
117no Mouse;
118
119### Buffers
120# buffers are stored in Cache::LRU as reference, so recently
121# unused buffers are automatically purged.
122# TODO FIXME currently playing track's buffer should not be purged!!!
123
124our $BufferCache = Cache::LRU::Peekable->new(size => 20);
125
126sub track_id { refaddr $_[0] }
127
128sub buffer_ref {
129    my $self = shift;
130    return $BufferCache->get($self->track_id) || $BufferCache->set($self->track_id, \(my $s = ''));
131}
132
133sub buffer {
134    my $self = shift;
135    return ${ $self->buffer_ref };
136}
137
138sub append_buffer {
139    my ($self, $buf) = @_;
140    my $ref = $self->buffer_ref;
141    $$ref .= $buf;
142}
143
144sub buffer_length {
145    my $self = shift;
146    return length $self->buffer;
147}
148
149sub has_buffer {
150    my $self = shift;
151    return !! $BufferCache->peek($self->track_id);
152}
153
154sub peek_buffer_length {
155    my $self = shift;
156    my $buffer_ref = $BufferCache->peek($self->track_id) or return 0;
157    return length $$buffer_ref;
158}
159
160### Instantiation
161
162our $UrlToInstance;
163our $IdToInstance;
164
165sub BUILD {
166    my $self = shift;
167    weaken($UrlToInstance->{ $self->url } = $self);
168    weaken($IdToInstance->{ $self->track_id } = $self);
169}
170
171my @subclasses;
172sub subclasses {
173    my $class = shift;
174    return @subclasses if @subclasses;
175    file(__FILE__)->dir->subdir('Track')->recurse(
176        callback => sub {
177            my $pm = shift;
178            $pm = $pm->relative(file(__FILE__)->parent->parent);
179            $pm =~ s/\.pm$// or return;
180            $pm =~ s/\//::/g;
181            Class::Load::load_class($pm);
182            return unless $pm->meta->get_method('_play');
183            push @subclasses, $pm;
184        },
185    );
186    return @subclasses;
187}
188
189# below does not create instance
190sub of_url {
191    my ($class, $url) = @_;
192    return $UrlToInstance->{$url};
193}
194
195sub of_track_id {
196    my ($class, $id) = @_;
197    return $IdToInstance->{ $id };
198}
199
200sub from_url {
201    my ($class, $url, %args) = @_;
202    if (my $track = $class->of_url($url)) {
203        return $track;
204    }
205    foreach my $impl ($class->subclasses) {
206        my $args = $impl->buildargs_from_url($url) or next;
207        return $impl->new(url => $url, %$args, %args);
208    }
209}
210
211### Subclasses must implement these
212
213sub buildargs_from_url {
214    my $class = shift;
215    die 'override';
216}
217
218sub _play {
219    my $self = shift;
220    die 'override';
221}
222
223###
224
225sub add_error {
226    my ($self, $error) = @_;
227    $self->log(error => $error);
228    $self->{error} = $self->{error} ? "$self->{error}; $error" : $error;
229}
230
231sub is_track_url {
232    my ($class, $url) = @_;
233    foreach my $impl ($class->subclasses) {
234        $impl->buildargs_from_url($url) and return 1;
235    }
236    return 0;
237}
238
239sub is_system { 0 }
240
241sub log_extra_info {
242    my $self = shift;
243    return $self->url->path_query;
244}
245
246sub prepare {
247    my $self = shift;
248    $self->log(debug => 'prepare');
249    $self->media_url; # build
250}
251
252sub play {
253    my $self = shift;
254
255    if ($self->is_playing) {
256        $self->log(debug => 'already playing');
257        return $self->error ? 0 : 1;
258    } elsif ($self->is_done) {
259        $self->log(debug => 'already done');
260        return $self->error ? 0 : 1;
261    }
262
263    $self->log(info => 'start playing');
264    $self->status(TRACK_STATUS_PLAYING);
265    $self->buffer; # initialize
266    $self->_play;
267
268    if ($self->error) {
269        $self->done;
270        return 0;
271    }
272
273    return 1;
274}
275
276sub write {
277    my $self = shift;
278    $self->append_buffer($_[0]);
279    # $self->log(debug => 'broadcast buffer_signal');
280    $self->buffer_signal->broadcast;
281}
282
283sub buffer_read_fh {
284    my $self = shift;
285    open my $fh, '<', \$self->{buffer};
286}
287
288### Utility methods
289
290sub recv_cv {
291    my ($self, $cv) = @_;
292    $cv->cb(Coro::rouse_cb);
293    Coro::rouse_wait;
294    return $cv->recv;
295}
296
297sub sleep {
298    my ($self, $n) = @_;
299    $self->log(info => "sleep for $n secs");
300    Coro::Timer::sleep $n;
301}
302
303sub run_command {
304    my ($self, $command, $args) = @_;
305
306    my $head = $command->[0];
307
308    $args ||= {};
309    $args->{'>'}  ||= sub {
310        $self->log(debug => "$head: STDOUT: $_[0]") if defined $_[0];
311    };
312    $args->{'2>'} ||= sub {
313        $self->log(debug => "$head: STDERR: $_[0]") if defined $_[0];
314    };
315    $args->{'$$'} = \my $pid;
316
317    $self->log(debug => qq(running '@$command'));
318    my $cmd_cv = run_cmd $command, %{ $args || {} };
319    $self->log(debug => "$head: pid=$pid");
320
321    my $exit_code = $self->recv_cv($cmd_cv);
322    if ($exit_code != 0) {
323        $self->add_error("$head exited with code $exit_code");
324    } else {
325        $self->log(debug => "$head exited with code $exit_code");
326    }
327    return $exit_code;
328}
329
330# transcode file or fh to buffer
331sub ffmpeg {
332    my ($self, $file_or_fh) = @_;
333    my %args = (
334        '>'  => unblock_sub { $self->write($_[0]) if defined $_[0] },
335        '2>' => sub { $self->log_coro("ffmpeg: @_") },
336    );
337    
338    my $filename;
339    if (ref $file_or_fh) {
340        $filename = '-';
341        $args{'<'} = $file_or_fh;
342    } else {
343        $filename  = $file_or_fh;
344    }
345
346    $self->run_command(
347        [ qw(ffmpeg -i), $filename, qw(-ab 192k -ar 44100 -acodec libmp3lame -ac 2 -f mp3 -) ],
348        \%args,
349    );
350    $self->done;
351}
352
353sub url_to_fh {
354    my ($self, $url, %args) = @_;
355
356    my $cb = delete $args{cb};
357
358    my ($reader, $writer) = portable_pipe;
359    my $write_handle = AnyEvent::Handle->new(
360        fh => $writer,
361        on_error => sub {
362             my ($handle, $fatal, $msg) = @_;
363             $self->add_error("AnyEvent::Handle: $msg");
364             $handle->destroy;
365        }
366    );
367
368    $self->log(debug => "GET $url");
369
370    my $bytes_wrote = 0;
371    http_get(
372        $url,
373        headers => $self->prepare_headers($url),
374        on_header => sub {
375            my ($headers) = @_;
376            if ($headers->{Status} != 200) {
377                $self->add_error("http_get $url: $headers->{Status} $headers->{Reason}");
378                return;
379            }
380            1;
381        },
382        on_body => sub {
383            my ($content) = @_;
384            if (defined $content) {
385                $write_handle->push_write($content);
386                $bytes_wrote += length $content;
387            }
388            1;
389        },
390        sub {
391            $write_handle->on_drain(sub { close $_[0]->fh; $_[0]->destroy });
392            $self->log(info => "GET $url -> $bytes_wrote bytes");
393            $cb && $cb->();
394        },
395    );
396
397    return $reader;
398}
399
400sub prepare_headers {
401    my ($self, $url) = @_;
402
403    my %headers = (
404        'Referer' => undef,
405        'User-Agent' => $self->user_agent->agent,
406    );
407    $self->user_agent->prepare_request(GET $url)->scan(sub { $headers{$_[0]} = $_[1] });
408
409    return \%headers;
410}
411
412sub tempfile {
413    my $self = shift;
414    return File::Temp::tempfile(UNLINK => 0, @_);
415}
416
417sub temporary_filename {
418    my $self   = shift;
419    my $suffix = shift;
420    my (undef, $filename) = $self->tempfile(OPEN => 0, SUFFIX => $suffix, @_);
421    return $filename;
422}
423
424sub download_temporary {
425    my ($self, $url, $suffix) = @_;
426    my $filename = $self->temporary_filename($suffix);
427    my $res = $self->user_agent->mirror($url, $filename);
428    unless ($res->is_success) {
429        $self->add_error("mirroring $url to $filename: " .  $res->status_line);
430        return undef;
431    }
432    return $filename;
433}
434
435sub send_file_to_buffer {
436    my ($self, $file) = @_;
437    my $fh = ref $file ? $file : aio_open $file, IO::AIO::O_RDONLY, 0 or do {
438        $self->add_error("aio_open $file: $!");
439        return;
440    };
441    while (aio_read $fh, undef, 1024 * 1024, my $buf = '', 0) {
442        $self->write($buf);
443    }
444    aio_close $fh;
445    $self->done;
446}
447
448sub as_string {
449    my $self = shift;
450    my $string = "<$self->{url}>";
451    $string = $self->title . ' ' . $string if $self->title;
452    return $string;
453}
454
4551;