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 (15 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_902, HEAD
Changes since 1.10:	+1 -1 lines
Log Message:	0.902
#	Content
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	$VERSION = '0.902';
13
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	$self->{capability} = _capabilities_new ($self->{fd});
99	$self->{picture} = _picture_new ($self->{fd});
100
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	my $c = _channel_new ($_[0]->{fd});
110	$c->channel ($_[1]);
111	$c->get ? $c : ();
112	}
113
114	sub tuner($$) {
115	my $c = _tuner_new ($_[0]->{fd});
116	$c->tuner ($_[1]);
117	$c->get ? $c : ();
118	}
119
120	sub audio($$) {
121	my $c = _audio_new ($_[0]->{fd});
122	$c->audio ($_[1]);
123	$c->get ? $c : ();
124	}
125
126	sub freq($;$) {
127	_freq (shift->{fd},@_);
128	}
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	$self
184	}
185
186	sub fileno($) {
187	$_[0]->{fd}
188	}
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	but you rarely need to use them.
211
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	Marc Lehmann <schmorp@schmorp.de>
272
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