Video-Capture-V4l/V4l/V4l.pm

package Video::Capture::V4l;

use strict 'subs';
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);

require Exporter;
require DynaLoader;

use Fcntl;

$VERSION = '0.902';

@ISA = qw(Exporter DynaLoader);

@EXPORT = qw(
        MODE_AUTO MODE_NTSC MODE_PAL MODE_SECAM
        PALETTE_GREY PALETTE_HI240 PALETTE_PLANAR PALETTE_RAW PALETTE_RGB24
        PALETTE_RGB32 PALETTE_RGB555 PALETTE_RGB565 PALETTE_UYVY PALETTE_YUV410P
        PALETTE_YUV411 PALETTE_YUV411P PALETTE_YUV420 PALETTE_YUV420P PALETTE_YUV422
        PALETTE_YUV422P PALETTE_YUYV
        SOUND_LANG1 SOUND_LANG2 SOUND_MONO SOUND_STEREO
        VBI_MAXLINES VBI_BPL VBI_BPF
);

@EXPORT_OK = qw(
        MODE_AUTO MODE_NTSC MODE_PAL MODE_SECAM
        PALETTE_GREY PALETTE_HI240 PALETTE_PLANAR PALETTE_RAW PALETTE_RGB24
        PALETTE_RGB32 PALETTE_RGB555 PALETTE_RGB565 PALETTE_UYVY PALETTE_YUV410P
        PALETTE_YUV411 PALETTE_YUV411P PALETTE_YUV420 PALETTE_YUV420P PALETTE_YUV422
        PALETTE_YUV422P PALETTE_YUYV
        SOUND_LANG1 SOUND_LANG2 SOUND_MONO SOUND_STEREO
        AUDIO_MUTE 

        AUDIO_BASS AUDIO_MUTABLE AUDIO_TREBLE AUDIO_VOLUME
        TUNER_LOW TUNER_MBS_ON TUNER_NORM TUNER_NTSC TUNER_PAL
        TUNER_RDS_ON TUNER_SECAM TUNER_STEREO_ON
        VC_AUDIO VC_TUNER
        TYPE_CAMERA TYPE_TV

        BASE_VIDIOCPRIVATE
        CAPTURE_EVEN
        CAPTURE_ODD
        CLIPMAP_SIZE
        CLIP_BITMAP
        MAX_FRAME
        NO_UNIT
        PALETTE_COMPONENT
        WINDOW_INTERLACE
        HARDWARE_AZTECH
        HARDWARE_BROADWAY
        HARDWARE_BT848
        HARDWARE_CADET
        HARDWARE_GEMTEK
        HARDWARE_PERMEDIA2
        HARDWARE_PLANB
        HARDWARE_PMS
        HARDWARE_PSEUDO
        HARDWARE_QCAM_BW
        HARDWARE_QCAM_C
        HARDWARE_RIVA128
        HARDWARE_RTRACK
        HARDWARE_RTRACK2
        HARDWARE_SAA5249
        HARDWARE_SAA7146
        HARDWARE_SF16MI
        HARDWARE_TYPHOON
        HARDWARE_VIDEUM
        HARDWARE_VINO
        HARDWARE_ZOLTRIX
        TYPE_CAPTURE
        TYPE_CHROMAKEY
        TYPE_CLIPPING
        TYPE_FRAMERAM
        TYPE_MONOCHROME
        TYPE_OVERLAY
        TYPE_SCALES
        TYPE_SUBCAPTURE
        TYPE_TELETEXT
        TYPE_TUNER
);

# shit
sub VBI_MAXLINES        (){ 32 }
sub VBI_BPL             (){ 2048 }
sub VBI_BPF             (){ VBI_BPL * VBI_MAXLINES }

bootstrap Video::Capture::V4l $VERSION;

sub new(;$) {
   my $class  = shift;
   my $device = shift || "/dev/video0";
   my $self = bless { device => $device }, $class;

   $self->{handle} = local *{$device};
   sysopen $self->{handle},$device,O_RDWR or return;
   $self->{fd} = fileno ($self->{handle});
   $self->{capability} = _capabilities_new ($self->{fd});
   $self->{picture} = _picture_new ($self->{fd});

   $self->{capability}->get
   && $self->{picture}->get ? $self : ();
}

sub capability($) { shift->{capability} }
sub picture($)    { shift->{picture} }

sub channel($$) {
   my $c = _channel_new ($_[0]->{fd});
   $c->channel ($_[1]);
   $c->get ? $c : ();
}

sub tuner($$) {
   my $c = _tuner_new ($_[0]->{fd});
   $c->tuner ($_[1]);
   $c->get ? $c : ();
}

sub audio($$) {
   my $c = _audio_new ($_[0]->{fd});
   $c->audio ($_[1]);
   $c->get ? $c : ();
}

sub freq($;$) {
   _freq (shift->{fd},@_);
}

package Video::Capture::V4l::Capability;

sub capture   ($){ shift->type & &Video::Capture::V4l::TYPE_CAPTURE   }
sub tuner     ($){ shift->type & &Video::Capture::V4l::TYPE_TUNER     }
sub teletext  ($){ shift->type & &Video::Capture::V4l::TYPE_TELETEXT  }
sub overlay   ($){ shift->type & &Video::Capture::V4l::TYPE_OVERLAY   }
sub chromakey ($){ shift->type & &Video::Capture::V4l::TYPE_CHROMAKEY }
sub clipping  ($){ shift->type & &Video::Capture::V4l::TYPE_CLIPPING  }
sub frameram  ($){ shift->type & &Video::Capture::V4l::TYPE_FRAMERAM  }
sub scales    ($){ shift->type & &Video::Capture::V4l::TYPE_SCALES    }
sub monochrome($){ shift->type & &Video::Capture::V4l::TYPE_MONOCHROME}
sub subcapture($){ shift->type & &Video::Capture::V4l::TYPE_SUBCAPTURE}

package Video::Capture::V4l::Channel;

sub tuner     ($){ shift->flags & &Video::Capture::V4l::VC_TUNER      }
sub audio     ($){ shift->flags & &Video::Capture::V4l::VC_AUDIO      }

sub tv        ($){ shift->type & &Video::Capture::V4l::TYPE_TV        }
sub camera    ($){ shift->type & &Video::Capture::V4l::TYPE_CAMERA    }

package Video::Capture::V4l::Tuner;

sub pal       ($){ shift->flags & &Video::Capture::V4l::TUNER_PAL     }
sub ntsc      ($){ shift->flags & &Video::Capture::V4l::TUNER_NTSC    }
sub secam     ($){ shift->flags & &Video::Capture::V4l::TUNER_SECAM   }
sub low       ($){ shift->flags & &Video::Capture::V4l::TUNER_LOW     }
sub norm      ($){ shift->flags & &Video::Capture::V4l::TUNER_NORM    }
sub stereo_on ($){ shift->flags & &Video::Capture::V4l::TUNER_STEREO_ON}
sub rds_on    ($){ shift->flags & &Video::Capture::V4l::TUNER_RDS_ON  }
sub mbs_on    ($){ shift->flags & &Video::Capture::V4l::TUNER_MBS_ON  }

package Video::Capture::V4l::Audio;

sub mute      ($){ shift->flags & &Video::Capture::V4l::AUDIO_MUTE    }
sub mutatble  ($){ shift->flags & &Video::Capture::V4l::AUDIO_MUTABLE }
sub volume    ($){ shift->flags & &Video::Capture::V4l::AUDIO_VOLUME  }
sub bass      ($){ shift->flags & &Video::Capture::V4l::AUDIO_BASS    }
sub treble    ($){ shift->flags & &Video::Capture::V4l::AUDIO_TREBLE  }

package Video::Capture::V4l::VBI;

use Fcntl;

sub new(;$) {
   my $class  = shift;
   my $device = shift || "/dev/vbi0";
   my $self = bless { device => $device }, $class;

   $self->{handle} = local *{$device};
   sysopen $self->{handle},$device,O_RDWR or return;
   $self->{fd} = fileno ($self->{handle});

   $self
}

sub fileno($) {
   $_[0]->{fd}
}

1;
__END__

=head1 NAME

Video::Capture::V4l - Perl interface to the Video4linux framegrabber interface.

=head1 SYNOPSIS

  use Video::Capture::V4l;

=head1 DESCRIPTION

Not documentation AGAIN! Please see the scripts grab, inexer or vbi that
are packaged in the distribution and direct any question and feature
requests (as well as bug reports) to the author.

=head1 Exported constants

The following hideous constants are defined in the C<Video::Capture::V4l> package,
but you rarely need to use them.

  AUDIO_BASS
  AUDIO_MUTABLE
  AUDIO_MUTE
  AUDIO_TREBLE
  AUDIO_VOLUME
  CAPTURE_EVEN
  CAPTURE_ODD
  MAX_FRAME
  MODE_AUTO
  MODE_NTSC
  MODE_PAL
  MODE_SECAM
  PALETTE_COMPONENT
  PALETTE_GREY
  PALETTE_HI240
  PALETTE_PLANAR
  PALETTE_RAW
  PALETTE_RGB24
  PALETTE_RGB32
  PALETTE_RGB555
  PALETTE_RGB565
  PALETTE_UYVY
  PALETTE_YUV410P
  PALETTE_YUV411
  PALETTE_YUV411P
  PALETTE_YUV420
  PALETTE_YUV420P
  PALETTE_YUV422
  PALETTE_YUV422P
  PALETTE_YUYV
  SOUND_LANG1
  SOUND_LANG2
  SOUND_MONO
  SOUND_STEREO
  TUNER_LOW
  TUNER_MBS_ON
  TUNER_NORM
  TUNER_NTSC
  TUNER_PAL
  TUNER_RDS_ON
  TUNER_SECAM
  TUNER_STEREO_ON
  TYPE_CAMERA
  TYPE_TV
  VC_AUDIO
  VC_TUNER
  TYPE_CAPTURE
  TYPE_CHROMAKEY
  TYPE_CLIPPING
  TYPE_FRAMERAM
  TYPE_MONOCHROME
  TYPE_OVERLAY
  TYPE_SCALES
  TYPE_SUBCAPTURE
  TYPE_TELETEXT
  TYPE_TUNER

=head1 AUTHOR

Marc Lehmann <schmorp@schmorp.de>

=head1 LICENSE

This module is available under GPL only (see the file COPYING for
details), if you want an exception please contact the author, who might
grant exceptions freely ;)

=head1 SEE ALSO

perl(1).

=cut
Revision:	1.11
Committed:	Thu Jul 24 20:55:20 2008 UTC (18 years, 1 month ago) by root
Branch:	MAIN
CVS Tags:	rel-0_902, HEAD
Changes since 1.10:	+1 -1 lines
Log Message:	0.902
#	User	Rev	Content
1	pcg	1.1	package Video::Capture::V4l;
2
3			use strict 'subs';
4			use Carp;
5			use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
6
7			require Exporter;
8			require DynaLoader;
9
10			use Fcntl;
11
12	root	1.11	$VERSION = '0.902';
13	pcg	1.1
14			@ISA = qw(Exporter DynaLoader);
15
16			@EXPORT = qw(
17			MODE_AUTO MODE_NTSC MODE_PAL MODE_SECAM
18			PALETTE_GREY PALETTE_HI240 PALETTE_PLANAR PALETTE_RAW PALETTE_RGB24
19			PALETTE_RGB32 PALETTE_RGB555 PALETTE_RGB565 PALETTE_UYVY PALETTE_YUV410P
20			PALETTE_YUV411 PALETTE_YUV411P PALETTE_YUV420 PALETTE_YUV420P PALETTE_YUV422
21			PALETTE_YUV422P PALETTE_YUYV
22			SOUND_LANG1 SOUND_LANG2 SOUND_MONO SOUND_STEREO
23			VBI_MAXLINES VBI_BPL VBI_BPF
24			);
25
26			@EXPORT_OK = qw(
27			MODE_AUTO MODE_NTSC MODE_PAL MODE_SECAM
28			PALETTE_GREY PALETTE_HI240 PALETTE_PLANAR PALETTE_RAW PALETTE_RGB24
29			PALETTE_RGB32 PALETTE_RGB555 PALETTE_RGB565 PALETTE_UYVY PALETTE_YUV410P
30			PALETTE_YUV411 PALETTE_YUV411P PALETTE_YUV420 PALETTE_YUV420P PALETTE_YUV422
31			PALETTE_YUV422P PALETTE_YUYV
32			SOUND_LANG1 SOUND_LANG2 SOUND_MONO SOUND_STEREO
33			AUDIO_MUTE
34
35			AUDIO_BASS AUDIO_MUTABLE AUDIO_TREBLE AUDIO_VOLUME
36			TUNER_LOW TUNER_MBS_ON TUNER_NORM TUNER_NTSC TUNER_PAL
37			TUNER_RDS_ON TUNER_SECAM TUNER_STEREO_ON
38			VC_AUDIO VC_TUNER
39			TYPE_CAMERA TYPE_TV
40
41			BASE_VIDIOCPRIVATE
42			CAPTURE_EVEN
43			CAPTURE_ODD
44			CLIPMAP_SIZE
45			CLIP_BITMAP
46			MAX_FRAME
47			NO_UNIT
48			PALETTE_COMPONENT
49			WINDOW_INTERLACE
50			HARDWARE_AZTECH
51			HARDWARE_BROADWAY
52			HARDWARE_BT848
53			HARDWARE_CADET
54			HARDWARE_GEMTEK
55			HARDWARE_PERMEDIA2
56			HARDWARE_PLANB
57			HARDWARE_PMS
58			HARDWARE_PSEUDO
59			HARDWARE_QCAM_BW
60			HARDWARE_QCAM_C
61			HARDWARE_RIVA128
62			HARDWARE_RTRACK
63			HARDWARE_RTRACK2
64			HARDWARE_SAA5249
65			HARDWARE_SAA7146
66			HARDWARE_SF16MI
67			HARDWARE_TYPHOON
68			HARDWARE_VIDEUM
69			HARDWARE_VINO
70			HARDWARE_ZOLTRIX
71			TYPE_CAPTURE
72			TYPE_CHROMAKEY
73			TYPE_CLIPPING
74			TYPE_FRAMERAM
75			TYPE_MONOCHROME
76			TYPE_OVERLAY
77			TYPE_SCALES
78			TYPE_SUBCAPTURE
79			TYPE_TELETEXT
80			TYPE_TUNER
81			);
82
83			# shit
84			sub VBI_MAXLINES (){ 32 }
85			sub VBI_BPL (){ 2048 }
86			sub VBI_BPF (){ VBI_BPL * VBI_MAXLINES }
87
88			bootstrap Video::Capture::V4l $VERSION;
89
90			sub new(;$) {
91			my $class = shift;
92			my $device = shift \|\| "/dev/video0";
93			my $self = bless { device => $device }, $class;
94
95			$self->{handle} = local *{$device};
96			sysopen $self->{handle},$device,O_RDWR or return;
97			$self->{fd} = fileno ($self->{handle});
98	root	1.5	$self->{capability} = _capabilities_new ($self->{fd});
99			$self->{picture} = _picture_new ($self->{fd});
100	pcg	1.1
101			$self->{capability}->get
102			&& $self->{picture}->get ? $self : ();
103			}
104
105			sub capability($) { shift->{capability} }
106			sub picture($) { shift->{picture} }
107
108			sub channel($$) {
109	root	1.5	my $c = _channel_new ($_[0]->{fd});
110			$c->channel ($_[1]);
111	pcg	1.1	$c->get ? $c : ();
112			}
113
114			sub tuner($$) {
115	root	1.5	my $c = _tuner_new ($_[0]->{fd});
116			$c->tuner ($_[1]);
117	pcg	1.1	$c->get ? $c : ();
118			}
119
120			sub audio($$) {
121	root	1.5	my $c = _audio_new ($_[0]->{fd});
122			$c->audio ($_[1]);
123	pcg	1.1	$c->get ? $c : ();
124			}
125
126			sub freq($;$) {
127	root	1.5	_freq (shift->{fd},@_);
128	pcg	1.1	}
129
130			package Video::Capture::V4l::Capability;
131
132			sub capture ($){ shift->type & &Video::Capture::V4l::TYPE_CAPTURE }
133			sub tuner ($){ shift->type & &Video::Capture::V4l::TYPE_TUNER }
134			sub teletext ($){ shift->type & &Video::Capture::V4l::TYPE_TELETEXT }
135			sub overlay ($){ shift->type & &Video::Capture::V4l::TYPE_OVERLAY }
136			sub chromakey ($){ shift->type & &Video::Capture::V4l::TYPE_CHROMAKEY }
137			sub clipping ($){ shift->type & &Video::Capture::V4l::TYPE_CLIPPING }
138			sub frameram ($){ shift->type & &Video::Capture::V4l::TYPE_FRAMERAM }
139			sub scales ($){ shift->type & &Video::Capture::V4l::TYPE_SCALES }
140			sub monochrome($){ shift->type & &Video::Capture::V4l::TYPE_MONOCHROME}
141			sub subcapture($){ shift->type & &Video::Capture::V4l::TYPE_SUBCAPTURE}
142
143			package Video::Capture::V4l::Channel;
144
145			sub tuner ($){ shift->flags & &Video::Capture::V4l::VC_TUNER }
146			sub audio ($){ shift->flags & &Video::Capture::V4l::VC_AUDIO }
147
148			sub tv ($){ shift->type & &Video::Capture::V4l::TYPE_TV }
149			sub camera ($){ shift->type & &Video::Capture::V4l::TYPE_CAMERA }
150
151			package Video::Capture::V4l::Tuner;
152
153			sub pal ($){ shift->flags & &Video::Capture::V4l::TUNER_PAL }
154			sub ntsc ($){ shift->flags & &Video::Capture::V4l::TUNER_NTSC }
155			sub secam ($){ shift->flags & &Video::Capture::V4l::TUNER_SECAM }
156			sub low ($){ shift->flags & &Video::Capture::V4l::TUNER_LOW }
157			sub norm ($){ shift->flags & &Video::Capture::V4l::TUNER_NORM }
158			sub stereo_on ($){ shift->flags & &Video::Capture::V4l::TUNER_STEREO_ON}
159			sub rds_on ($){ shift->flags & &Video::Capture::V4l::TUNER_RDS_ON }
160			sub mbs_on ($){ shift->flags & &Video::Capture::V4l::TUNER_MBS_ON }
161
162			package Video::Capture::V4l::Audio;
163
164			sub mute ($){ shift->flags & &Video::Capture::V4l::AUDIO_MUTE }
165			sub mutatble ($){ shift->flags & &Video::Capture::V4l::AUDIO_MUTABLE }
166			sub volume ($){ shift->flags & &Video::Capture::V4l::AUDIO_VOLUME }
167			sub bass ($){ shift->flags & &Video::Capture::V4l::AUDIO_BASS }
168			sub treble ($){ shift->flags & &Video::Capture::V4l::AUDIO_TREBLE }
169
170			package Video::Capture::V4l::VBI;
171
172			use Fcntl;
173
174			sub new(;$) {
175			my $class = shift;
176			my $device = shift \|\| "/dev/vbi0";
177			my $self = bless { device => $device }, $class;
178
179			$self->{handle} = local *{$device};
180			sysopen $self->{handle},$device,O_RDWR or return;
181			$self->{fd} = fileno ($self->{handle});
182
183	root	1.8	$self
184	pcg	1.1	}
185
186			sub fileno($) {
187	root	1.8	$_[0]->{fd}
188	pcg	1.1	}
189
190			1;
191			__END__
192
193			=head1 NAME
194
195			Video::Capture::V4l - Perl interface to the Video4linux framegrabber interface.
196
197			=head1 SYNOPSIS
198
199			use Video::Capture::V4l;
200
201			=head1 DESCRIPTION
202
203			Not documentation AGAIN! Please see the scripts grab, inexer or vbi that
204			are packaged in the distribution and direct any question and feature
205			requests (as well as bug reports) to the author.
206
207			=head1 Exported constants
208
209			The following hideous constants are defined in the C<Video::Capture::V4l> package,
210	root	1.5	but you rarely need to use them.
211	pcg	1.1
212			AUDIO_BASS
213			AUDIO_MUTABLE
214			AUDIO_MUTE
215			AUDIO_TREBLE
216			AUDIO_VOLUME
217			CAPTURE_EVEN
218			CAPTURE_ODD
219			MAX_FRAME
220			MODE_AUTO
221			MODE_NTSC
222			MODE_PAL
223			MODE_SECAM
224			PALETTE_COMPONENT
225			PALETTE_GREY
226			PALETTE_HI240
227			PALETTE_PLANAR
228			PALETTE_RAW
229			PALETTE_RGB24
230			PALETTE_RGB32
231			PALETTE_RGB555
232			PALETTE_RGB565
233			PALETTE_UYVY
234			PALETTE_YUV410P
235			PALETTE_YUV411
236			PALETTE_YUV411P
237			PALETTE_YUV420
238			PALETTE_YUV420P
239			PALETTE_YUV422
240			PALETTE_YUV422P
241			PALETTE_YUYV
242			SOUND_LANG1
243			SOUND_LANG2
244			SOUND_MONO
245			SOUND_STEREO
246			TUNER_LOW
247			TUNER_MBS_ON
248			TUNER_NORM
249			TUNER_NTSC
250			TUNER_PAL
251			TUNER_RDS_ON
252			TUNER_SECAM
253			TUNER_STEREO_ON
254			TYPE_CAMERA
255			TYPE_TV
256			VC_AUDIO
257			VC_TUNER
258			TYPE_CAPTURE
259			TYPE_CHROMAKEY
260			TYPE_CLIPPING
261			TYPE_FRAMERAM
262			TYPE_MONOCHROME
263			TYPE_OVERLAY
264			TYPE_SCALES
265			TYPE_SUBCAPTURE
266			TYPE_TELETEXT
267			TYPE_TUNER
268
269			=head1 AUTHOR
270
271	root	1.6	Marc Lehmann <schmorp@schmorp.de>
272	pcg	1.1
273			=head1 LICENSE
274
275			This module is available under GPL only (see the file COPYING for
276			details), if you want an exception please contact the author, who might
277			grant exceptions freely ;)
278
279			=head1 SEE ALSO
280
281			perl(1).
282
283			=cut