1 |
package Video::XawTV; |
2 |
|
3 |
=head1 NAME |
4 |
|
5 |
Video::XawTV - read, create and edit .xawtvrc's. |
6 |
|
7 |
=head1 SYNOPSIS |
8 |
|
9 |
use Video::XawTV; |
10 |
|
11 |
$rc = new Video::XawTV; |
12 |
# - or - |
13 |
$rc = new Video::XawTV "$HOME{ENV}/.xawtv"; |
14 |
$rc->load("otherrcfile"); |
15 |
$rc->save; |
16 |
$rc->save("filename"); |
17 |
|
18 |
$source = $rc->opt('source'); |
19 |
$rc->opt('source') = "Television"; |
20 |
|
21 |
@channels = $rc->channels; |
22 |
$rc->channels(@channels); |
23 |
|
24 |
print $channels[0]{name}; # Arte |
25 |
print $channels[0]{channel}; # E4 |
26 |
|
27 |
=head1 DESCRIPTION |
28 |
|
29 |
Pardon? Ha! Haa! Hahahahahaha!!! |
30 |
|
31 |
=cut |
32 |
|
33 |
$VESRSION = 0.1; |
34 |
|
35 |
use Carp; |
36 |
|
37 |
sub new { |
38 |
my $self = bless {}, shift; |
39 |
$self->load(shift) if @_; |
40 |
$self; |
41 |
} |
42 |
|
43 |
my %std_global = ( |
44 |
norm => 1, |
45 |
capture => 1, |
46 |
source => 1, |
47 |
color => 1, |
48 |
bright => 1, |
49 |
hue => 1, |
50 |
contrast => 1, |
51 |
fullscreen => 1, |
52 |
wm-off-by => 1, |
53 |
freqtab => 1, |
54 |
pixsize => 1, |
55 |
'jpeg-quality'=> 1, |
56 |
mixer => 1, |
57 |
lauch => 1, |
58 |
); |
59 |
|
60 |
my %std_channel = ( |
61 |
channel => 1, |
62 |
fine => 1, |
63 |
norm => 1, |
64 |
key => 1, |
65 |
capture => 1, |
66 |
source => 1, |
67 |
color => 1, |
68 |
bright => 1, |
69 |
hue => 1, |
70 |
contrast => 1, |
71 |
); |
72 |
|
73 |
sub load { |
74 |
my $self = shift; |
75 |
my $fn = shift; |
76 |
local $_; |
77 |
open FN, "<$fn" or croak "unable to open '$fn': $!"; |
78 |
$self->{fn} = $fn; |
79 |
$self->{channels} = []; |
80 |
my $channel = $self->{global} = {}; |
81 |
my $std = \%std_global; |
82 |
while (<FN>) { |
83 |
if (/^#Video::XawTV=#\s*(\S+)\s*=\s*(.*)\s*$/) { |
84 |
$channel->{lc $1} = $2; |
85 |
} elsif (/^\s*#(.*)$/) { |
86 |
# comments are being reordered, but.. my! |
87 |
$channel->{"#$1"} = 1; |
88 |
} elsif (/^\s*(\S+)\s*=\s*(.*)\s*$/) { |
89 |
$channel->{lc $1} = $2; |
90 |
$std->{lc $1}++; |
91 |
} elsif (/\s*\[(.*)\]\s*$/) { |
92 |
push @{$self->{channels}}, $channel = { name => $1 }; |
93 |
$std = \%std_channel; |
94 |
} elsif (/\S/) { |
95 |
chomp; |
96 |
croak "unparsable statement in '$fn': '$_'"; |
97 |
} |
98 |
} |
99 |
close FN; |
100 |
} |
101 |
|
102 |
sub save_hash { |
103 |
my ($fh, $hash, $std) = @_; |
104 |
while (my ($k,$v) = each %$hash) { |
105 |
next if $k eq 'name'; |
106 |
if ($k =~ /^#/) { |
107 |
print $fh $k, "\n"; |
108 |
} else { |
109 |
print $fh "#Video::XawTV=#" unless $std->{lc $k}; |
110 |
print $fh "$k = $v\n"; |
111 |
} |
112 |
} |
113 |
print $fh "\n"; |
114 |
} |
115 |
|
116 |
sub save { |
117 |
my $self = shift; |
118 |
my $fn = shift || $self->{fn}; |
119 |
open FN,">$fn~" or croak "unable to open '$fn~' for writing: $!"; |
120 |
save_hash(*FN, $self->{global}, \%std_global); |
121 |
for (@{$self->{channels}}) { |
122 |
print FN "[", $_->{name}, "]\n"; |
123 |
save_hash(*FN, $_, \%std_channel); |
124 |
} |
125 |
close FN; |
126 |
rename "$fn~", $fn or croak "unable to replace '$fn': $!"; |
127 |
} |
128 |
|
129 |
sub opt { |
130 |
my $self = shift; |
131 |
my $opt = shift; |
132 |
$self->{global}{$opt} = shift if @_; |
133 |
$self->{global}{$opt}; |
134 |
} |
135 |
|
136 |
sub channels { |
137 |
my $self = shift; |
138 |
if (@_) { |
139 |
$self->{channels} = ref $_[0] eq "ARRAY" ? $_[0] : [@_]; |
140 |
} |
141 |
wantarray ? @{$self->{channels}} : $self->{channels}; |
142 |
} |
143 |
|
144 |
1; |