config/mpfire/perl/Audio/MPD/Test.pm

   1 #
   2 # This file is part of Audio::MPD
   3 # Copyright (c) 2007 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8 #
   9
  10 package Audio::MPD::Test;
  11
  12 use strict;
  13 use warnings;
  14
  15 use Exporter;
  16 use FindBin     qw[ $Bin ];
  17 use Readonly;
  18
  19
  20 use base qw[ Exporter ];
  21 our @EXPORT = qw[ customize_test_mpd_configuration start_test_mpd stop_test_mpd ];
  22 #our ($VERSION) = '$Rev: 5284 $' =~ /(\d+)/;
  23
  24
  25 Readonly my $TEMPLATE => "$Bin/mpd-test/mpd.conf.template";
  26 Readonly my $CONFIG   => "$Bin/mpd-test/mpd.conf";
  27
  28 { # this will be run when Audio::MPD::Test will be use-d.
  29     my $restart = 0;
  30     my $stopit  = 0;
  31
  32     customize_test_mpd_configuration();
  33     $restart = _stop_user_mpd_if_needed();
  34     $stopit  = start_test_mpd();
  35
  36     END {
  37         stop_test_mpd() if $stopit;
  38         return unless $restart;       # no need to restart
  39         system 'mpd 2>/dev/null';     # restart user mpd
  40         sleep 1;                      # wait 1 second to let mpd start.
  41     }
  42 }
  43
  44
  45 #--
  46 # public subs
  47
  48 #
  49 # customize_test_mpd_configuration( [$port] )
  50 #
  51 # Create a fake mpd configuration file, based on the file mpd.conf.template
  52 # located in t/mpd-test. The string PWD will be replaced by the real path -
  53 # ie, where the tarball has been untarred. The string PORT will be replaced
  54 # by $port if specified, 6600 otherwise (MPD default).
  55 #
  56 sub customize_test_mpd_configuration {
  57     my ($port) = @_;
  58     $port ||= 6600;
  59
  60     # open template and config.
  61     open my $in,  '<',  $TEMPLATE or die "can't open [$TEMPLATE]: $!\n";
  62     open my $out, '>',  $CONFIG   or die "can't open [$CONFIG]: $!\n";
  63
  64     # replace string and fill in config file.
  65     while ( defined( my $line = <$in> ) ) {
  66         $line =~ s!PWD!$Bin/mpd-test!;
  67         $line =~ s!PORT!$port!;
  68         print $out $line;
  69     }
  70
  71     # clean up.
  72     close $in;
  73     close $out;
  74
  75     # create a fake mpd db.
  76     system( "mpd --create-db $CONFIG >/dev/null 2>&1" ) == 0
  77         or die "could not create fake mpd database: $?\n";
  78 }
  79
  80
  81 #
  82 # start_test_mpd()
  83 #
  84 # Start the fake mpd, and die if there were any error.
  85 #
  86 sub start_test_mpd {
  87     my $output = qx[mpd $CONFIG 2>&1];
  88     die "could not start fake mpd: $output\n" if $output;
  89     sleep 1;   # wait 1 second to let mpd start.
  90     return 1;
  91 }
  92
  93
  94 #
  95 # stop_test_mpd()
  96 #
  97 # Kill the fake mpd.
  98 #
  99 sub stop_test_mpd {
 100     system "mpd --kill $CONFIG 2>/dev/null";
 101     sleep 1;   # wait 1 second to free output device.
 102     unlink "$Bin/mpd-test/state", "$Bin/mpd-test/music.db";
 103 }
 104
 105
 106 #--
 107 # private subs
 108
 109
 110 #
 111 # my $was_running = _stop_user_mpd_if_needed()
 112 #
 113 # This sub will check if mpd is currently running. If it is, force it to
 114 # a full stop (unless MPD_TEST_OVERRIDE is not set).
 115 #
 116 # In any case, it will return a boolean stating whether mpd was running
 117 # before forcing stop.
 118 #
 119 sub _stop_user_mpd_if_needed {
 120     # check if mpd is running.
 121     my $is_running = grep { /mpd$/ } qx[ ps -e ];
 122
 123     return 0 unless $is_running; # mpd does not run - nothing to do.
 124
 125     # check force stop.
 126     die "mpd is running\n" unless $ENV{MPD_TEST_OVERRIDE};
 127     system( 'mpd --kill 2>/dev/null') == 0 or die "can't stop user mpd: $?\n";
 128     sleep 1;  # wait 1 second to free output device
 129     return 1;
 130 }
 131
 132
 133 1;
 134
 135 __END__
 136
 137 =head1 NAME
 138
 139 Audio::MPD::Test - automate launching of fake mdp for testing purposes
 140
 141
 142 =head1 SYNOPSIS
 143
 144     use Audio::MPD::Test; # die if error
 145     [...]
 146     stop_fake_mpd();
 147
 148
 149 =head1 DESCRIPTION
 150
 151 =head2 General usage
 152
 153 This module will try to launch a new mpd server for testing purposes. This
 154 mpd server will then be used during Audio::MPD tests.
 155
 156 In order to achieve this, the module will create a fake mpd.conf file with
 157 the correct pathes (ie, where you untarred the module tarball). It will then
 158 check if some mpd server is already running, and stop it if the
 159 MPD_TEST_OVERRIDE environment variable is true (die otherwise). Last it will
 160 run the test mpd with its newly created configuration file.
 161
 162 Everything described above is done automatically when the module is C<use>-d.
 163
 164
 165 Once the tests are run, the mpd server will be shut down, and the original
 166 one will be relaunched (if there was one).
 167
 168 Note that the test mpd will listen to C<localhost>, so you are on the safe
 169 side. Note also that the test suite comes with its own ogg files - and yes,
 170 we can redistribute them since it's only some random voice recordings :-)
 171
 172
 173 =head2 Advanced usage
 174
 175 In case you want more control on the test mpd server, you can use the
 176 following public methods:
 177
 178 =over 4
 179
 180 =item start_test_mpd()
 181
 182 Start the fake mpd, and die if there were any error.
 183
 184 =item stop_test_mpd()
 185
 186 Kill the fake mpd.
 187
 188 =item customize_test_mpd_configuration( [$port] )
 189
 190 Create a fake mpd configuration file, based on the file mpd.conf.template
 191 located in t/mpd-test. The string PWD will be replaced by the real path -
 192 ie, where the tarball has been untarred. The string PORT will be replaced
 193 by $port if specified, 6600 otherwise (MPD default).
 194
 195 =back
 196
 197 This might be useful when trying to test connections with mpd server.
 198
 199
 200 =head1 SEE ALSO
 201
 202 L<Audio::MPD>
 203
 204
 205 =head1 AUTHOR
 206
 207 Jerome Quelin, C<< <jquelin at cpan.org> >>
 208
 209
 210 =head1 COPYRIGHT & LICENSE
 211
 212 Copyright (c) 2007 Jerome Quelin, all rights reserved.
 213
 214 This program is free software; you can redistribute it and/or modify
 215 it under the same terms as Perl itself.
 216
 217 =cut