File Coverage

blib/lib/Ogg/Vorbis/Header.pm

Criterion	Covered	Total	%
statement	0	73	0.0
branch	0	44	0.0
condition	0	19	0.0
subroutine	0	10	0.0
pod	10	10	100.0
total	10	156	6.4

package Ogg::Vorbis::Header;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.05';

use Inline C => 'DATA',
					LIBS => '-logg -lvorbis -lvorbisfile',
					INC => '-I/inc',
					AUTO_INCLUDE => '#include "inc/vcedit.h"',
					AUTO_INCLUDE => '#include "inc/vcedit.c"',
					VERSION => '0.05',
					NAME => 'Ogg::Vorbis::Header';

# constructors

# wrap this so $obj->new will work right
sub new {
	my ($id, $path) = @_;
	$id = ref($id) || $id;
	_new($id, $path);
}

sub load {
	my ($id, $path) = @_;
	unless (ref($id)) {
		$id = _new($id, $path);
	}
	return $id unless $id;
	$id->_load_info;
	$id->_load_comments;
	return $id;
}

# A number of the instance methods may be handled with perl code.

sub info {
	my ($self, $key) = @_;
	$self->_load_info unless $self->{INFO};
	if ($key) {
		return $self->{INFO}->{$key}
	}
	return $self->{INFO};
}

sub comment_tags {
	my $self = shift;
	$self->_load_comments unless $self->{COMMENTS};
	return keys %{$self->{COMMENTS}};
}

sub comment {
	my ($self, $key) = @_;
	my $result;
	return undef unless $key;
	$self->_load_comments unless $self->{COMMENTS};
	if (! defined ($result = $self->{COMMENTS}->{$key})) {
		return undef;
	}
	return @{$result};
}

sub add_comments {
	my ($self, @comments) = @_;
	# For now play it safe limit both tag and field to minimal ascii
	# will work on utf8 in field later
	return undef if @comments < 2 or @comments % 2 != 0;
	$self->_load_comments unless $self->{COMMENTS};
	while ($#comments >= 0) {
		my $key = shift @comments;
		$key =~ s/[^\x20-\x3C\x3E-\x7D]//g;
		$key = lc($key);
		my $val = shift @comments;
		$val =~ s/[^\x20-\x7D]//g;
		push @{$self->{COMMENTS}->{$key}}, $val;
	}

	return 1;
}

sub edit_comment {
	my ($self, $key, $value, $num) = @_;
	$num ||= 0;

	return undef unless $key and $value and $num =~ /^\d*$/;
	$self->_load_comments unless $self->{COMMENTS};

	my $comment = $self->{COMMENTS}->{$key};
	return undef unless $comment;
	$value =~ s/[^\x20-\x7D]//g;
	return undef unless @$comment > $num;

	my $result = $comment->[$num];
	$comment->[$num] = $value;

	return $result;
}

sub delete_comment {
	my ($self, $key, $num) = @_;
	$num ||= 0;

	return undef unless $key and $num =~ /^\d*$/;
	$self->_load_comments unless $self->{COMMENTS};

	my $comment = $self->{COMMENTS}->{$key};
	return undef unless $comment;
	return undef unless @$comment > $num;

	my $result = splice @$comment, $num, 1;

	if (@$comment == 0) {
		delete($self->{COMMENTS}->{$key});
	}

	return $result;
}

sub clear_comments {
	my ($self, @keys) = @_;

	$self->_load_comments unless $self->{COMMENTS};
	if (@keys) {
		foreach (@keys) {
			return undef unless $self->{COMMENTS}->{$_};
			delete($self->{COMMENTS}->{$_});
		}
	} else {
		foreach (keys %{$self->{COMMENTS}}) {
			delete($self->{COMMENTS}->{$_});
		}
	}
	return 1;
}

sub path {
	my $self = shift;
	return $self->{PATH};
}

1;
__DATA__