| 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; |
