mplayer.pm

用perl和gtk+写的调用mplayer播放电视的软件

    return 1;
}

sub gui_about
{
    my $self = shift;
    return undef unless $self->check_mplayer();

    syswrite $min, "gui_about\n";
    return 1;
}

sub gui_play
{
    my $self = shift;
    return undef unless $self->check_mplayer();

    syswrite $min, "gui_play\n";
    return 1;
}

sub gui_stop
{
    my $self = shift;
    return undef unless $self->check_mplayer();

    syswrite $min, "gui_stop\n";
    return 1;
}

# added by cyclops, 2004-05-24
# internal function, do not use!
sub tv_thread
{
    my ($out_mode, $function, $param) = @_;
    my $line = "";
    my $ret = -1;
    my $c;
    if ($tv_thread_run == -1) {
        push @error, "MPlayer not running, can't start thread\n";
        return;
    }
    $tv_thread_run = 1;
    if ($out_mode == 1) {
        open FH, ">/tmp/mplayertv.log";
        select FH;
    }
    if ($out_mode == 2) {
        select STDOUT; $| = 1;      # make unbuffered
    }
    while ($ret != 0) {
        $ret = sysread $mout, $c, 1;
        next unless $ret;
        print $c if ($out_mode >= 1);
        if ($c eq "\n") {
            if ($line =~ /^Selected channel.* - ([\s\w]+) \(.*/) {
                my $new_channel = $1;
                $new_channel =~ s/ /_/g;
                &$function ($param, $new_channel);
            }
            else {
                push @moutput, $line;
            }
            $line = "";
        }
        else {
            $line .= $c;
        }
    }
    select STDOUT;
    close FH if ($out_mode == 1);
    $tv_thread_run = 0;
}

# added by cyclops, 2004-05-24
# returns true if thread is running (mplayer running)
sub tv_thread_running
{
    my $self = shift;
    return undef unless $self->check_mplayer();
    return $tv_thread_run;
}

# added by cyclops, 2004-05-24
# if user steps channel run callback function
sub tv_set_channel_step_callback
{
    my $self = shift;
    my $out_mode = shift;
    my $function = shift;
    my $param = shift;
    return undef unless $self->check_mplayer();
    if ($tv_thread_run) {
        push @error, "Thread already running";
        return undef;
    }
    my $thread  = threads->create(\&tv_thread, $out_mode, $function, $param);
    return 1;
}

#tv_step_channel <dir>
#	Select next/\:previous tv channel.
sub tv_step_channel
{
    my $self = shift;
    my $dir = shift;
    return $self->argerr() unless defined $dir;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_step_channel $dir\n";
    return 1;
}

#tv_step_norm
#	Change TV norm.
sub tv_step_norm
{
    my $self = shift;
    return undef unless $self->check_mplayer();
   
    syswrite $min, "tv_step_norm\n";
    return 1;
}

#tv_step_chanlist
#	Change channel list.
sub tv_step_chanlist
{
    my $self = shift;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_step_chanlist\n";
    return 1;
}

#tv_set_channel channel
#	Set the current TV channel.
sub tv_set_channel 
{
    my $self = shift;
    my $channel = shift;
    return unless defined $channel;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_channel $channel\n";
    return 1;
}

#tv_last_channel
#	Set the current TV channel to the last one.
sub tv_last_channel
{
    my $self = shift;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_last_channel\n";
    return 1;
}

#tv_set_freq <frequency in MHz>
#	Set the tv tuner frequency.
sub tv_set_freq
{
    my $self = shift;
    my $freq = shift;
    return $self->argerr() unless defined $freq;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_freq $freq\n";
    return 1;
}

#tv_set_norm <norm>
#	Set the tv tuner norm. PAL, SECAM, NTSC and so on..
sub tv_set_norm
{
    my $self = shift;
    my $norm = shift;
    return $self->argerr() unless defined $norm;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_norm $norm\n";
    return 1;
}

#tv_set_brightness [-100:100]
#	Set tv tuner brightness.
sub tv_set_brightness 
{
    my $self = shift;
    my $value = shift;
    return $self->argerr() unless defined $value;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_brightness $value\n";
    return 1;
}

#tv_set_contrast [-100:100]
#	Set tv tuner contrast.
sub tv_set_contrast
{
    my $self = shift;
    my $value = shift;
    return $self->argerr() unless defined $value;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_contrast $value\n";
    return 1;
}

#tv_set_hue [-100:100]
#	Set tv tuner hue.
sub tv_set_hue
{
    my $self = shift;
    my $value = shift;
    return $self->argerr() unless defined $value;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_hue $value\n";
    return 1;
}

#tv_set_saturation [-100:100]
#	Set tv tuner saturation.
sub tv_set_saturation 
{
    my $self = shift;
    my $value = shift;
    return $self->argerr() unless defined $value;
    return undef unless $self->check_mplayer();

    syswrite $min, "tv_set_saturation $value\n";
    return 1;
}

sub error 
{
    my $self = shift;
    if (wantarray) {
	return @error;
    } else {
	return pop @error;
    }
}

sub output
{
    my $self = shift;
    if (wantarray) {
	return @moutput;
    } else {
	return join ("\n", @moutput);
    }
}

# TODO fix bug!
# bug: if user quitting with q then check_mplayer returns 1!
sub check_mplayer
{
    my $self = shift;
    return 0 unless $mpid;
    if (kill 0, $mpid) {
       return 1;
    } else {
        push @error, "MPlayer died for some reason";
        return 0;
    }
}

sub argerr
{
    my $self = shift;
    my $call = caller();

    push @error, "Function $call was called with the wrong arguments";
    return undef;
}

sub not_implemented
{
    my $self = shift;
    my $call = caller();

    push @error, "Function $call is not implemented";
    return undef;
}


1; #this line is important and will help the module return a true value
__END__


########################################### main pod documentation begin ##
# Below is the stub of documentation for your module. You better edit it!


=head1 NAME

MPlayer - An OO interface to MPlayer for Perl (modified by Peter Ivanov)

=head1 SYNOPSIS

  use MPlayer
  
  my $mp = new MPlayer("./opensource.ogg", "-ao" => "oss");

  sleep 10;

  $mp->mute();

  $mp->quit();

  $mp = new MPlayer("some_movie.avi", "-cache" => 1024);

  $mp->vo_fullscreen();

  $mp->pause();

  my @error = $mp->error;
  print join "\n", @error;

  #Show last error:
  my $error = $mp->error
  print $error;

  $mp->tv_step_channel(1);
  $mp->tv_set_channel(2);

=head1 DESCRIPTION

MPlayer.pm is a simple interface to MPlayers slave mode command and
can be used inside a perlscript.

=head1 NOTE

MPlayer.pm does not keep block, i.e. if your script exits before the
sound file is finished, it will just kill MPlayer. This module
might be used to write interfaces in Perl::Tk or Curses::UI which
have a Mainloop for flowcontrol.

=head1 GENERAL

MPlayer implements all calls documented in DOCS/tech/slave.txt. 
Calls will return a true value on success and 'undef' otherwise.
Some calls are not documented at all, they return 'undef' defaultly.
If an error occurs you can access those errors through a call
to $mp->error() which will give you a string error description.

See DOCS/tech/slave.txt in the mplayer source tree for all calls
and their options.

The tv_ calls can be called thourgh $mp->tv_...

=head1 USAGE

=over 4

=item new( filename, mplayer_opts... )

Filename is mandatory, MPlayer needs a given filename to start
up. Mplayer_opts can be any of MPlayers command line options as
an anonymous hash (e.g. "-cache" => 1024 ).

=item error() 

Returns descriptions of errors that have occured in MPlayer.pm.
In array context it returns all errors, in scalar context the
last error that occured.


=back

=head1 INSTALL

At the very least you should be able to use this set of instructions
to install the module...

    perl Makefile.PL
    make
    make test
    make install


If you are on a windows box you should use 'nmake' rather than 'make'.


=head1 BUGS

This is the first version, mostly untested when it comes to TV stuff.
If you find a bug please report it to the author.


=head1 AUTHOR

	Marcus Thiesen
	[e-mail]
	http://www.thiesenweb.de

        Peter Ivanov
        http://www.mplayertv.tk

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO

perl(1).
mplayer

=cut