line
stmt
bran
cond
sub
pod
time
code
1
package Music::Audioscrobbler::MPD;
2
our $VERSION = 0.13;
3
require 5.006;
4
5
# Copyright (c) 2007 Edward J. Allen III
6
# Some code and inspiration from Audio::MPD Copyright (c) 2005 Tue Abrahamsen, Copyright (c) 2006 Nicholas J. Humfrey, Copyright (c) 2007 Jerome Quelin
7
8
#
9
# You may distribute under the terms of either the GNU General Public
10
# License or the Artistic License, as specified in the README file.
11
#
12
13
14
# the GNU Public License. Both are distributed with Perl.
15
16
=pod
17
18
=for changes stop
19
20
=head1 NAME
21
22
Music::Audioscrobbler::MPD - Module providing routines to submit songs to last.fm from MPD.
23
24
=for readme stop
25
26
=head1 SYNOPSIS
27
28
use Music::Audioscrobbler::MPD
29
my $mpds = Music::Audioscrobbler::MPD->new(\%options);
30
$mpds->monitor_mpd();
31
32
=for readme continue
33
34
=head1 DESCRIPTION
35
36
Music::Audioscrobbler::MPD is a scrobbler for MPD. As of version .1, L is used to submit information to last.fm.
37
38
All internal code is subject to change. See L for usage info.
39
40
=begin readme
41
42
=head1 INSTALLATION
43
44
To install this module type the following:
45
46
perl Makefile.PL
47
make
48
make test
49
make install
50
51
=head1 CONFIGURATION
52
53
There is a sample config file under examples. A sample init file that I use for
54
gentoo linux is there as well.
55
56
=head1 USE
57
58
Edit the sample config file and copy to /etc/musicmpdscrobble.conf or ~/.musicmpdscrobble.conf
59
60
Test your configuration by issue the command
61
62
musicmpdscrobble --logfile=STDERR --monitor
63
64
and playing some music.
65
66
If it works, then the command
67
68
musicmpdscrobble --daemonize
69
70
will run musicmpdscrobble as a daemon. Please see examples for a sample init script. If you make an init script
71
for your distribution, please send it to me!
72
73
=head1 DEPENDENCIES
74
75
This module requires these other modules and libraries:
76
77
Music::Audioscrobbler::Submit
78
File::Spec
79
Digest::MD5
80
Encode
81
IO::Socket
82
IO::File
83
Config::Options
84
85
I strongly encourage you to also install my module
86
87
Music::Tag
88
89
This will allow you to read info from the file tag (such as the MusicBrainz ID).
90
91
The version info in the Makefile is based on what I use. You can get
92
away with older versions in many cases.
93
94
=end readme
95
96
=head1 MORE HELP
97
98
Please see the documentation for L which is available from
99
100
musicmpdscrobble --longhelp
101
102
=for readme stop
103
104
=cut
105
106
1
1
77487
use strict;
1
4
1
85
107
1
1
7
use warnings;
1
3
1
40
108
1
1
9338
use Music::Audioscrobbler::Submit;
1
191308
1
35
109
1
1
14
use File::Spec;
1
1
1
27
110
1
1
5
use Digest::MD5 qw(md5_hex);
1
2
1
67
111
1
1
6
use Encode qw(encode);
1
3
1
45
112
1
1
1241
use IO::Socket;
1
27804
1
6
113
1
1
709
use IO::File;
1
3
1
137
114
1
1
5
use Config::Options;
1
2
1
26
115
1
1
5
use POSIX qw(WNOHANG);
1
1
1
10
116
#use Storable;
117
118
119
sub _default_options {
120
1
50
1
53
{ lastfm_username => undef,
50
121
lastfm_password => undef,
122
mdb_opts => {},
123
musictag => 0,
124
musictag_overwrite => 0,
125
verbose => 1,
126
monitor => 1,
127
daemonize => 0,
128
timeout => 15, # Set low to prevent missing a scrobble. Rather retry submit.
129
pidfile => "/var/run/musicmpdscrobble.pid",
130
logfile => undef,
131
default_cache_time => 86400,
132
mpd_password => undef,
133
allow_stream => 0,
134
mpd_server => $ENV{MPD_HOST} || 'localhost',
135
mpd_port => $ENV{MPD_PORT} || 6600,
136
music_directory => "/mnt/media/music/MP3s",
137
scrobble_queue => $ENV{HOME} . "/.musicaudioscrobbler_queue",
138
optionfile => [ "/etc/musicmpdscrobble.conf", $ENV{HOME} . "/.musicmpdscrobble.conf" ],
139
runonstart => [],
140
runonsubmit => [],
141
lastfm_client_id => "mam",
142
lastfm_client_version => "0.1",
143
music_tag_opts => {
144
quiet => 1,
145
verbose => 0,
146
ANSIColor => 0,
147
},
148
};
149
}
150
151
=head1 METHODS
152
153
=over 4
154
155
=item new()
156
157
my $mpds = Music::Audioscrobbler::MPD->new($options);
158
159
=cut
160
161
sub new {
162
1
1
1
19
my $class = shift;
163
1
50
5
my $options = shift || {};
164
1
4
my $self = {};
165
1
4
bless $self, $class;
166
1
7
$self->options( $self->_default_options );
167
1
50
492
if ($options->{optionfile}) {
168
0
0
$self->options->options("optionfile", $options->{optionfile});
169
}
170
1
5
$self->options->fromfile_perl( $self->options->{optionfile} );
171
1
66
$self->options($options);
172
1
34
$self->{scrobble_ok} = 1;
173
1
8
$self->_convert_password();
174
175
1
50
10
if ($self->options->{lastfm_client_id} eq "tst") {
176
0
0
$self->status(0, "WARNING: Using client id 'tst' is NO LONGER approved. Please use 'mam' or other assigned ID");
177
}
178
1
50
12
if ($self->options("mpd_server") =~ /^(.*)@(.*)/) {
179
0
0
$self->options->{"mpd_server"} = $2;
180
0
0
$self->options->{"mpd_password"} = $1;
181
}
182
1
17
return $self;
183
}
184
185
sub _convert_password {
186
1
1
2
my $self = shift;
187
1
50
4
unless ( $self->options('lastfm_md5password') ) {
188
1
50
17
if ( $self->options('lastfm_password') ) {
189
1
17
$self->options->{lastfm_md5password} =
190
Digest::MD5::md5_hex( $self->options->{lastfm_password} );
191
1
21
delete $self->options->{lastfm_password};
192
}
193
}
194
}
195
196
197
=item monitor_mpd()
198
199
Starts the main loop.
200
201
=cut
202
203
sub monitor_mpd {
204
0
0
1
0
my $self = shift;
205
0
0
$self->status( 1, "Starting Music::Audioscrobbler::MPD version $VERSION" );
206
0
0
while (1) {
207
0
0
0
if ( $self->is_connected ) {
208
0
0
$self->update_info();
209
0
0
sleep 1;
210
}
211
else {
212
0
0
$self->connect;
213
0
0
sleep 4;
214
}
215
0
0
0
unless ( $self->{scrobble_ok} ) {
216
0
0
0
if ( ( time - $self->{lastscrobbled} ) > 600 ) {
217
0
0
$self->{scrobble_ok} = $self->mas->process_scrobble_queue();
218
0
0
$self->{lastscrobbled} = time;
219
}
220
}
221
0
0
$self->_reaper();
222
}
223
}
224
225
=item options()
226
227
Get or set options via hash. Here is a list of available options:
228
229
=over 4
230
231
=item optionfile
232
233
Perl file used to get options from
234
235
=item lastfm_username
236
237
lastfm username
238
239
=item lastfm_password
240
241
lastfm password. Not needed if lastfm_md5password is set.
242
243
=item lastfm_md5password
244
245
MD5 hash of lastfm password.
246
247
=item lastfm_client_id
248
249
Client ID provided by last.fm. Defaults to "tst", which is valid for testing only.
250
251
=item lastfm_client_version
252
253
Set to the version of your program when setting a valid client_id. Defaults to "1.0"
254
255
=item mpd_server
256
257
hostname of mpd_server
258
259
=item mpd_port
260
261
port for mpd_server
262
263
=item mpd_password
264
265
mpd password
266
267
=item verbose
268
269
Set verbosity level (1 through 4)
270
271
=item logfile
272
273
File to output loginfo to
274
275
=item scrobblequeue
276
277
Path to file to queue info to
278
279
=item music_directory
280
281
Root to MP3 files
282
283
=item get_mbid_from_mb
284
285
Use the Music::Tag::MusicBrainz plugin to get missing "mbid" value.
286
287
=item runonsubmit
288
289
Array of commands to run after submit
290
291
=item runonstart
292
293
Array of commands to run on start of play
294
295
=item monitor
296
297
True if monitor should be turned on
298
299
=item musictag
300
301
True if you want to use Music::Tag to get info from file
302
303
=item musictag_overwrite
304
305
True if you want to Music::Tag info to override file info
306
307
308
=item music_tag_opts
309
310
Options for Music::Tag
311
312
=item proxy_server
313
314
Specify a procy server in the form http://proxy.server.tld:8080. Please note that environment is checked for HTTP_PROXY, so you may not need this option.
315
316
=item allow_stream
317
318
If set to true, will scrobble HTTP streams.
319
320
=back
321
322
=back
323
324
=cut
325
326
sub options {
327
11
11
1
42
my $self = shift;
328
11
100
33
if ( exists $self->{_options} ) {
329
10
37
return $self->{_options}->options(@_);
330
}
331
else {
332
1
13
$self->{_options} = Config::Options->new();
333
1
44
return $self->{_options}->options(@_);
334
}
335
}
336
337
=head1 INTERNAL METHODS (for reference)
338
339
=over
340
341
=item mpdsock()
342
343
returns open socket to mpd program.
344
345
=cut
346
347
sub mpdsock {
348
0
0
1
my $self = shift;
349
0
my $new = shift;
350
0
0
if ($new) {
351
0
$self->{mpdsock} = $new;
352
}
353
0
0
unless ( exists $self->{mpdsock} ) {
354
0
$self->{mpdsock} = undef;
355
}
356
0
return $self->{mpdsock};
357
}
358
359
=item connect()
360
361
Connect to MPD if necessary
362
363
=cut
364
365
sub connect {
366
0
0
1
my $self = shift;
367
0
0
0
if ( ( $self->mpdsock ) && ( $self->is_connected ) ) {
368
0
$self->status( 3, "Already connected just fine." );
369
0
return 1;
370
}
371
372
$self->mpdsock(
373
0
IO::Socket::INET->new( PeerAddr => $self->options("mpd_server"),
374
PeerPort => $self->options("mpd_port"),
375
Proto => 'tcp',
376
)
377
);
378
379
0
0
0
unless ( ( $self->mpdsock ) && ( $self->mpdsock->connected ) ) {
380
0
$self->status( 1, "Could not create socket to mpd: $!" );
381
0
return 0;
382
}
383
384
0
0
if ( $self->mpdsock->getline() =~ /^OK MPD (.+)$/ ) {
385
0
$self->{mpd_sever_version} = $1;
386
}
387
else {
388
0
$self->status( 1, "Bad response from mpd ($!)" );
389
0
return 0;
390
}
391
0
0
$self->send_password if $self->options("mpd_password");
392
0
return 1;
393
}
394
395
=item is_connected()
396
397
Return true if connected to mpd.
398
399
=cut
400
401
sub is_connected {
402
0
0
1
my $self = shift;
403
0
0
0
if ( ( $self->mpdsock ) && ( $self->mpdsock->connected ) ) {
404
0
$self->mpdsock->print("ping\n");
405
0
return ( $self->mpdsock->getline() =~ /^OK/ );
406
}
407
0
return undef;
408
}
409
410
=item process_feedback
411
412
Process response from mpd.
413
414
=cut
415
416
sub process_feedback {
417
0
0
1
my $self = shift;
418
0
my @output;
419
0
0
0
if ( ( $self->mpdsock ) && ( $self->mpdsock->connected ) ) {
420
0
while ( my $line = $self->mpdsock->getline() ) {
421
0
chomp($line);
422
423
# Did we cause an error? Save the data!
424
0
0
if ( $line =~ /^ACK \[(\d+)\@(\d+)\] {(.*)} (.+)$/ ) {
425
0
$self->{ack_error_id} = $1;
426
0
$self->{ack_error_command_id} = $2;
427
0
$self->{ack_error_command} = $3;
428
0
$self->{ack_error} = $4;
429
0
$self->status( 1, "Error sent to MPD: $line" );
430
0
return undef;
431
}
432
0
0
last if ( $line =~ /^OK/ );
433
0
push( @output, $line );
434
}
435
}
436
437
# Let's return the output for post-processing
438
0
return @output;
439
}
440
441
=item send_command($command)
442
443
send a command to mpd.
444
445
=cut
446
447
sub send_command {
448
0
0
1
my $self = shift;
449
0
0
if ( $self->is_connected ) {
450
0
$self->mpdsock->print( @_, "\n" );
451
0
return $self->process_feedback;
452
}
453
}
454
455
=item send_password($command)
456
457
send password to mpd.
458
459
=cut
460
461
sub send_password {
462
0
0
1
my $self = shift;
463
0
$self->send_command( "password ", $self->options("mpd_password"));
464
}
465
466
=item get_info($command)
467
468
Send mpd a command and parse the output if output is a column seperated list.
469
470
=cut
471
472
sub get_info {
473
0
0
1
my $self = shift;
474
0
my $command = shift;
475
0
my $ret = {};
476
0
foreach ( $self->send_command($command) ) {
477
0
0
if (/^(.[^:]+):\s(.+)$/) {
478
0
$ret->{$1} = $2;
479
}
480
}
481
0
return $ret;
482
}
483
484
=item get_status($command)
485
486
487
get_status command. Returns hashref with:
488
489
* volume: (0-100)
490
* repeat: (0 or 1)
491
* random: (0 or 1)
492
* playlist: (31-bit unsigned integer, the playlist version number)
493
* playlistlength: (integer, the length of the playlist)
494
* playlistqueue: (integer, the temporary fifo playlist version number)
495
* xfade: (crossfade in seconds)
496
* state: ("play", "stop", or "pause")
497
* song: (current song stopped on or playing, playlist song number)
498
* songid: (current song stopped on or playing, playlist songid)
499
* time: : (of current playing/paused song)
500
* bitrate: (instantaneous bitrate in kbps)
501
* audio: ::
502
* updating_db:
503
* error: if there is an error, returns message here
504
505
=cut
506
507
sub get_status {
508
0
0
1
my $self = shift;
509
0
$self->get_info("status");
510
}
511
512
=item get_current_song_info($command)
513
514
get_status command. Returns hashref with:
515
516
file: albums/bob_marley/songs_of_freedom/disc_four/12.bob_marley_-_could_you_be_loved_(12"_mix).flac
517
Time: 327
518
Album: Songs Of Freedom - Disc Four
519
Artist: Bob Marley
520
Title: Could You Be Loved (12" Mix)
521
Track: 12
522
Pos: 11
523
Id: 6601
524
525
=cut
526
527
sub get_current_song_info {
528
0
0
1
my $self = shift;
529
0
$self->get_info("currentsong");
530
}
531
532
=item status($level, @message)
533
534
Print to log.
535
536
=cut
537
538
sub status {
539
0
0
1
my $self = shift;
540
0
my $level = shift;
541
0
0
if ( $level <= $self->options->{verbose} ) {
542
0
my $out = $self->logfileout;
543
0
print $out scalar localtime(), " ", @_, "\n";
544
}
545
}
546
547
=item logfileout
548
549
returns filehandle to log.
550
551
=cut
552
553
sub logfileout {
554
0
0
1
my $self = shift;
555
0
my $fh = shift;
556
0
0
if ($fh) {
557
0
$self->{logfile} = $fh;
558
}
559
0
0
0
if ((not $self->options->{logfile}) or ($self->options->{logfile} eq "STDERR" )) {
0
560
0
return \*STDERR;
561
}
562
elsif ($self->options->{logfile} eq "STDOUT" ) {
563
0
return \*STDOUT;
564
}
565
0
0
0
unless ( ( exists $self->{logfile} ) && ( $self->{logfile} ) ) {
566
0
my $fh = IO::File->new( $self->options->{logfile}, ">>" );
567
0
0
unless ($fh) {
568
0
print STDERR "Error opening log, using STDERR: $!";
569
0
return \*STDERR;
570
}
571
0
$fh->autoflush(1);
572
0
$self->{logfile} = $fh;
573
}
574
0
return $self->{logfile};
575
}
576
577
=item mas()
578
579
Reference to underlying Music::Audioscrobbler::Submit object. If passed a Music::Audioscrobbler::Submit object, will
580
use that one instead.
581
582
=cut
583
584
sub mas {
585
0
0
1
my $self = shift;
586
0
my $new = shift;
587
0
0
if ($new) {
588
0
$self->{mas} = $new;
589
}
590
0
0
0
unless ((exists $self->{mas}) && (ref $self->{mas})) {
591
0
$self->{mas} = Music::Audioscrobbler::Submit->new($self->options);
592
0
$self->{mas}->logfileout($self->logfileout);
593
}
594
0
return $self->{mas};
595
}
596
597
=item new_info($cinfo)
598
599
reset current song info.
600
601
=cut
602
603
sub new_info {
604
0
0
1
my $self = shift;
605
0
my $cinfo = shift;
606
0
$self->{current_song} = $cinfo->{file};
607
0
0
if ( $self->{current_song} =~ /^http/i ) {
0
608
0
0
if ($self->options("allow_stream")) {
609
0
$self->{current_file} = 0;
610
}
611
else {
612
0
$self->{current_file} = undef;
613
}
614
}
615
elsif ( -e File::Spec->rel2abs( $self->{current_song}, $self->options->{music_directory} ) ) {
616
0
$self->{current_file} =
617
File::Spec->rel2abs( $self->{current_song}, $self->options->{music_directory} );
618
}
619
else {
620
0
$self->status(1, "File not found: ", File::Spec->rel2abs( $self->{current_song}, $self->options->{music_directory} ));
621
0
$self->{current_file} = 0;
622
}
623
0
my $h = { album => $cinfo->{Album},
624
artist => $cinfo->{Artist},
625
title => $cinfo->{Title},
626
secs => $cinfo->{Time},
627
};
628
0
0
if ($self->options->{musictag}) {
629
0
$h->{filename} = $self->{current_file};
630
}
631
0
$self->{info} = $self->mas->info_to_hash( $h );
632
633
#Prevent excessive calls to info_to_hash
634
0
delete $self->{info}->{filename};
635
636
0
$self->{song_duration} = $cinfo->{Time};
637
0
$self->{current_id} = $cinfo->{Id};
638
0
$self->{running_time} = 0;
639
0
$self->{last_running_time} = undef;
640
0
$self->{state} = "";
641
0
$self->{started_at} = time;
642
0
0
$self->status( 1, "New Song: ", $self->{current_id}, " - ", ($self->{current_file} ? $self->{current_file} : "Unknown File: $self->{current_song}") );
643
}
644
645
=item song_change($cinfo)
646
647
Run on song change
648
649
=cut
650
651
sub song_change {
652
0
0
1
my $self = shift;
653
0
my $cinfo = shift;
654
0
0
0
if ( ( defined $self->{current_file} )
0
0
0
655
and ( ( $self->{running_time} >= 240 )
656
or ( $self->{running_time} >= ( $self->{song_duration} / 2 ) ) )
657
and ( ( $self->{song_duration} >= 30 ) or ( $self->{info}->{mbid} ) )
658
) {
659
0
$self->scrobble();
660
0
$self->run_commands( $self->options->{runonsubmit} );
661
}
662
else {
663
0
$self->status( 4, "Not scrobbling ",
664
$self->{current_file}, " with run time of ",
665
$self->{running_time} );
666
}
667
0
my $state = $self->{state};
668
0
$self->new_info($cinfo);
669
0
0
0
if ( ( defined $self->{current_file} ) && ( $cinfo->{Time} ) && ( $state eq "play" ) ) {
0
670
0
$self->status( 4, "Announcing start of play for: ", $self->{current_file} );
671
0
$self->mas->now_playing( $self->{info} );
672
0
$self->run_commands( $self->options->{runonstart} );
673
}
674
else {
675
0
$self->status( 4, "Not announcing start of play for: ", $self->{current_file} );
676
}
677
0
$self->status("4", "Storing debug info");
678
#$Storable::forgive_me = 1;
679
#store($self, $self->options->{logfile}.".debug");
680
}
681
682
=item update_info()
683
684
Run on poll
685
686
=cut
687
688
sub update_info {
689
0
0
1
my $self = shift;
690
0
my $status = $self->get_status;
691
0
my $cinfo = $self->get_current_song_info();
692
0
$self->{state} = $status->{state};
693
0
my ( $so_far, $total ) = (0,0);
694
0
0
if ($status->{'time'}) {
695
0
( $so_far, $total ) = split( /:/, $status->{'time'} );
696
}
697
0
my $time = time;
698
0
0
0
if ( $self->{state} eq "play" ) {
0
699
0
0
unless ( $cinfo->{Id} eq $self->{current_id} ) {
700
0
$self->song_change($cinfo);
701
}
702
0
0
unless ( defined $self->{last_running_time} ) {
703
0
$self->{last_running_time} = $so_far;
704
}
705
0
0
unless ( defined $self->{last_update_time} ) {
706
0
$self->{last_update_time} = $time;
707
}
708
0
my $run_since_update = ( $so_far - $self->{last_running_time} );
709
710
0
my $time_since_update =
711
( $time - $self->{last_update_time} ) + 5; # Adding 5 seconds for rounding fudge
712
713
0
0
0
if ( ( $run_since_update > 0 ) && ( $run_since_update <= $time_since_update ) ) {
0
0
0
714
0
$self->{running_time} += $run_since_update;
715
}
716
elsif ( ( $run_since_update < -240 )
717
or ( $run_since_update < ( -1 * ( $self->{song_duration} / 2 ) ) ) ) {
718
0
$self->status(
719
3,
720
"Long skip back detected ( $run_since_update ). You like this song. Scrobbling... "
721
);
722
0
$self->song_change($cinfo);
723
}
724
elsif ($run_since_update) {
725
0
$self->status( 3, "Skip detected, ignoring time change." );
726
}
727
0
$self->{last_running_time} = $so_far;
728
0
$self->{last_update_time} = $time;
729
}
730
elsif ( ( $self->{state} eq "stop" ) && ( $self->{running_time} ) ) {
731
0
$self->song_change($cinfo);
732
}
733
0
0
if ( $self->options->{monitor} ) {
734
0
$self->monitor();
735
}
736
}
737
738
739
=item monitor()
740
741
print current status to STDERR
742
743
=cut
744
745
sub monitor {
746
0
0
1
my $self = shift;
747
0
0
printf STDERR "%5s ID: %4s TIME: %5s \r", $self->{state} ? $self->{state} : "", $self->{current_id} ? $self->{current_id} : "",
0
0
748
$self->{running_time} ? $self->{running_time} : "";
749
}
750
751
752
=item scrobble()
753
754
Scrobble current song
755
756
=cut
757
758
sub scrobble {
759
0
0
1
my $self = shift;
760
0
0
if ( defined $self->{current_file} ) {
761
0
$self->status( 2, "Adding ", $self->{current_file}, " to scrobble queue" );
762
0
$self->{scrobble_ok} = $self->mas->submit( [ $self->{info}, $self->{started_at} ] );
763
0
$self->{lastscrobbled} = time;
764
}
765
else {
766
0
$self->status( 3, "Skipping stream: ", $self->{current_file} );
767
}
768
}
769
770
771
=item run_commands()
772
773
Fork and run list of commands.
774
775
=cut
776
777
sub run_commands {
778
0
0
1
my $self = shift;
779
0
my $commands = shift;
780
0
0
0
return unless ( ( ref $commands ) && ( scalar @{$commands} ) );
0
781
0
my $pid = fork;
782
0
0
if ($pid) {
0
783
0
$self->_toreap($pid);
784
0
$self->status( 4, "Forked to run commands\n" );
785
}
786
elsif ( defined $pid ) {
787
0
0
if ( $self->options->{logfile} ) {
788
0
my $out = $self->logfileout;
789
0
open STDOUT, ">&", $out;
790
0
select STDOUT;
791
0
$| = 1;
792
0
open STDERR, ">&", $out;
793
0
select STDERR;
794
0
$| = 1;
795
}
796
0
foreach my $c ( @{$commands} ) {
0
797
0
$c =~ s/\%f/$self->{current_file}/e;
0
798
0
$c =~ s/\%a/$self->{info}->{artist}/e;
0
799
0
$c =~ s/\%b/$self->{info}->{album}/e;
0
800
0
$c =~ s/\%t/$self->{info}->{title}/e;
0
801
0
$c =~ s/\%l/$self->{info}->{secs}/e;
0
802
0
$c =~ s/\%n/$self->{info}->{track}/e;
0
803
0
$c =~ s/\%m/$self->{info}->{mbid}/e;
0
804
0
my $s = system($c);
805
0
delete $self->{fh};
806
807
0
0
if ($s) {
808
0
$self->status( 0, "Failed to run command: ${c}: $!" );
809
}
810
else {
811
0
$self->status( 2, "Command ${c} successful" );
812
}
813
}
814
0
exit;
815
}
816
else {
817
0
$self->status( 0, "Failed to fork for commands: $!" );
818
}
819
}
820
821
sub _toreap {
822
0
0
my $self = shift;
823
0
my $pid = shift;
824
0
0
unless (exists $self->{reapme}) {
825
0
$self->{reapme} = [];
826
}
827
0
push @{$self->{reapme}}, $pid;
0
828
}
829
830
sub _reaper {
831
0
0
my $self = shift;
832
0
0
if (exists $self->{reapme}) {
833
0
my @newreap = ();
834
0
foreach (@{$self->{reapme}}) {
0
835
0
0
(waitpid $_, WNOHANG) or push @newreap, $_;
836
}
837
0
0
if (@newreap) {
838
0
$self->{reapme} = \@newreap;
839
}
840
else {
841
0
delete $self->{reapme};
842
}
843
}
844
}
845
846
847
=back
848
849
=head1 SEE ALSO
850
851
L, L, L
852
853
=for changes continue
854
855
=head1 CHANGES
856
857
=over 4
858
859
=item Release Name: 0.13
860
861
=over 4
862
863
=item *
864
865
Added option allow_stream, which will allow scrobbling of http streams if set to true (default false). Feature untested.
866
867
=item *
868
869
Fixed bug in password submition (thanks joeblow1102)
870
871
=item *
872
873
Added support for password@host value in MPD_HOST
874
875
=item *
876
877
Searched, without success, for memory leak. If anyone wants to help, uncomment the Storable lines and start looking into it...
878
879
=item *
880
881
Added (documented) support for Proxy server
882
883
=back
884
885
=back
886
887
=over 4
888
889
=item Release Name: 0.12
890
891
=over 4
892
893
=item *
894
895
Fixed bug that sometimes prevented Music::Tag from working at all. Added some level 4 debug messages.
896
897
=back
898
899
=back
900
901
902
=over 4
903
904
=item Release Name: 0.11
905
906
=over 4
907
908
=item *
909
910
Added musictag_overwrite option. This is false by default. It is a workaround for problems with Music::Tag and unicode. Setting this to
911
true allows Music::Tag info to overwrite info from MPD. Do not set this to true until Music::Tag returns proper unicode consistantly.
912
913
=back
914
915
=back
916
917
=over 4
918
919
=item Release Name: 0.1
920
921
=over 4
922
923
=item *
924
925
Split off all scrobbling code to Music::Audioscrobbler::Submit
926
927
=item *
928
929
Added an error message if file is not found.
930
931
=item *
932
933
Added use warnings for better debugging.
934
935
=item *
936
937
Started using Pod::Readme for README and CHANGES
938
939
=back
940
941
=begin changes
942
943
=item Release Name: 0.09
944
945
=over 4
946
947
=item *
948
949
Added waffelmanna's patch to fix the password submital to MPD.
950
951
=back
952
953
=item Release Name: 0.08
954
955
=over 4
956
957
=item *
958
959
musicmpdscrobble daemonizes after creating Music::Audioscrobber::MPD object which allows pidfile to be set in options file (thanks K-os82)
960
961
=item *
962
963
Kwalitee changes such as pod fixes, license notes, etc.
964
965
=item *
966
967
Fixed bug which prevented working with a password to mpd.
968
969
=item *
970
971
Fixed bug causing reaper to block.
972
973
=back
974
975
=item Release Name: 0.07
976
977
=over 4
978
979
=item *
980
981
Fixed Unicode issues with double encoding (thanks slothck)
982
983
=item *
984
985
Stoped using URI::Encode which did NOT solve locale issues.
986
987
=back
988
989
=item Release Name: 0.06
990
991
=over 4
992
993
=item *
994
995
Configured get_mbid_from_mb to only grab if missing.
996
997
=item *
998
999
Changed to using URI::Encode
1000
1001
=item *
1002
1003
Fixed bug preventing log file from loading from command line.
1004
1005
=back
1006
1007
=item Release Name: 0.05
1008
1009
=over 4
1010
1011
=item *
1012
1013
Fixed bug with log file handles (thanks T0dK0n)
1014
1015
=item *
1016
1017
Fixed bug caused when music_directory not set (thanks T0dK0n)
1018
1019
=item *
1020
1021
Revised Documentation Slightly
1022
1023
=item *
1024
1025
Fixed bug in kill function for musicmpdscrobble
1026
1027
=item *
1028
1029
Added option get_mbid_from_mb to get missing mbids using Music::Tag::MusicBrainz
1030
1031
=back
1032
1033
=item Release Name: 0.04
1034
1035
=over 4
1036
1037
=item *
1038
1039
Have been assigned Client ID. If you set this in your configs, please remove.
1040
1041
=back
1042
1043
=item Release Name: 0.03
1044
1045
=over 4
1046
1047
=item *
1048
1049
Name change for module. Is now Music::Audioscrobbler::MPD. Uninstall old version to facilitate change!
1050
1051
=item *
1052
1053
Repeating a song isn't a skip anymore (or rather skipping back a scrobblable distance is not a skip)
1054
1055
=item *
1056
1057
Only submits a song <30 seconds long if it has an mbid.
1058
1059
=item *
1060
1061
Very basic test script for sanity.
1062
1063
=back
1064
1065
=item Release Name: 0.02
1066
1067
=over 4
1068
1069
=item *
1070
1071
Fixed bug caused my Music::Tag returning non-integer values for "secs" (thanks tunefish)
1072
1073
=item *
1074
1075
Along same lines, configure to not use Music::Tag secs values, but trust MPD
1076
1077
=back
1078
1079
=item Release Name: 0.01
1080
1081
=over 4
1082
1083
=item *
1084
1085
Initial Release
1086
1087
=item *
1088
1089
Basic routines for scrobbling MPD. Code from Music::Audioscrobbler merged for now.
1090
1091
=back
1092
1093
=end changes
1094
1095
=back
1096
1097
=for changes stop
1098
1099
=for readme continue
1100
1101
=head1 AUTHOR
1102
1103
Edward Allen, ealleniii _at_ cpan _dot_ org
1104
1105
=head1 COPYRIGHT
1106
1107
Copyright (c) 2007 Edward J. Allen III
1108
1109
Some code and inspiration from L
1110
Copyright (c) 2005 Tue Abrahamsen, Copyright (c) 2006 Nicholas J. Humfrey, Copyright (c) 2007 Jerome Quelin
1111
1112
=head1 LICENSE
1113
1114
This program is free software; you can redistribute it and/or modify
1115
it under the same terms as Perl itself, either:
1116
1117
a) the GNU General Public License as published by the Free
1118
Software Foundation; either version 1, or (at your option) any
1119
later version, or
1120
1121
b) the "Artistic License" which comes with Perl.
1122
1123
This program is distributed in the hope that it will be useful,
1124
but WITHOUT ANY WARRANTY; without even the implied warranty of
1125
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
1126
the GNU General Public License or the Artistic License for more details.
1127
1128
You should have received a copy of the Artistic License with this
1129
Kit, in the file named "Artistic". If not, I'll be glad to provide one.
1130
1131
You should also have received a copy of the GNU General Public License
1132
along with this program in the file named "Copying". If not, write to the
1133
Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
1134
Boston, MA 02110-1301, USA or visit their web page on the Internet at
1135
http://www.gnu.org/copyleft/gpl.html.
1136
1137
1138
=cut
1139
1140
1;