Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Ogg::Vorbis::Header

by dbp (Pilgrim)
on Sep 25, 2002 at 09:48 UTC ( [id://200588]=sourcecode: print w/replies, xml ) Need Help??
Category: Audio Related Programs
Author/Contact Info dan@lcws.org
Description:

This module presents an object-oriented interface to Ogg Vorbis files which allows users to view Vorbis info and comments and to modify or add comments. You can get the whole module here. It is also on CPAN.

Thanks to everyone who helped me with my Inline::C questions over the past few weeks. Also, if anyone finds errors in this code (esp mem or perl reference leaks) I'd like to hear about it.

Update: Note the new name (old was Ogg::Vorbis::Info). Dropped CPAN q as I've put it on now. Code is updated to reflect name.

package Ogg::Vorbis::Header;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

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.01',
                    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);
    }
    $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__

=head1 NAME

POD omitted from post...

=cut

__C__

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <vorbis/codec.h>
#include <vorbis/vorbisfile.h>

/* Loads info and length from the stream a fills the object's hash */
void _load_info(SV *obj)
{
    OggVorbis_File vf;
    vorbis_info *vi;
    FILE *fd;
    char *ptr;
    HV *th;
    HV *hash = (HV *) SvRV(obj);
    
    /* Open the vorbis stream file */
    ptr = (char *) SvIV(*(hv_fetch(hash, "_PATH", 5, 0)));
    if ((fd = fopen(ptr, "r")) == NULL) {
        perror("Error opening file in Ogg::Vorbis::Header::_load_info\
+n");
        return;
    }
    
    if (ov_open(fd, &vf, NULL, 0) < 0) {
        fclose(fd);
        perror("Error opening file in Ogg::Vorbis::Header::_load_info\
+n");
        return;
    }
    
    vi = ov_info(&vf, -1);
    
    th = newHV();
    hv_store(th, "version", 7, newSViv(vi->version), 0);
    hv_store(th, "channels", 8, newSViv(vi->channels), 0);
    hv_store(th, "rate", 4, newSViv(vi->rate), 0);
    hv_store(th, "bitrate_upper", 13, newSViv(vi->bitrate_upper), 0);
    hv_store(th, "bitrate_nominal", 15, newSViv(vi->bitrate_nominal), 
+0);
    hv_store(th, "bitrate_lower", 13, newSViv(vi->bitrate_lower), 0);
    hv_store(th, "bitrate_window", 14, newSViv(vi->bitrate_window), 0)
+;
    hv_store(th, "length", 6, newSVnv(ov_time_total(&vf, -1)), 0);
    
    hv_store(hash, "INFO", 4, newRV_noinc((SV *) th), 0);
    
    ov_clear(&vf);
}

/* Loads the commments from the stream and fills the object's hash */
void _load_comments(SV *obj)
{
    OggVorbis_File vf;
    vorbis_comment *vc;
    FILE *fd;
    HV *th;
    SV *ts;
    AV *ta;
    char *half;
    char *ptr;
    int i;
    HV *hash = (HV *) SvRV(obj);

    /* Open the vorbis stream file */
    ptr = (char *) SvIV(*(hv_fetch(hash, "_PATH", 5, 0)));
    if ((fd = fopen(ptr, "r")) == NULL) {
        perror("Error opening file in Ogg::Vorbis::Header::_load_comme
+nts\n");
        return;
    }
    
    if (ov_open(fd, &vf, NULL, 0) < 0) {
        fclose(fd);
        perror("Error opening file in Ogg::Vorbis::Header::_load_comme
+nts\n");
        return;
    }

    vc = ov_comment(&vf, -1);
    
    th = newHV();
    for (i = 0; i < vc->comments; ++i) {
        half = strchr(vc->user_comments[i], '=');
        if (! hv_exists(th, vc->user_comments[i],
                                        half - vc->user_comments[i])) 
+{
            ta = newAV();
            ts = newRV_noinc((SV*) ta);
            hv_store(th, vc->user_comments[i], half - vc->user_comment
+s[i],
                ts, 0);
        } else {
            ta = (AV*) SvRV(*(hv_fetch(th, vc->user_comments[i],
                        half - vc->user_comments[i], 0)));
        }
        av_push(ta, newSVpv(half + 1, 0));
    }

    hv_store(hash, "COMMENTS", 8, newRV_noinc((SV *) th), 0);

    ov_clear(&vf);
}

/* Our base object constructor.  Creates a blessed hash. */
SV* _new(char *class, char *path)
{
    /* A few variables */
    FILE *fd;
    char *_path;
    OggVorbis_File vf;
    
    /* Create our new hash and the reference to it. */
    HV *hash = newHV();
    SV *obj_ref = newRV_noinc((SV*) hash);

    /* Save an internal (c-style) rep of the path */
    _path = strdup(path);
    hv_store(hash, "_PATH", 5, newSViv((IV) _path), 0);
    
    /* Open the vorbis stream file */
    if ((fd = fopen(path, "r")) == NULL)
        return &PL_sv_undef;
    
    if (ov_test(fd, &vf, NULL, 0) < 0) {
        fclose(fd);
        return &PL_sv_undef;
    }

    /* Values stored at base level */
    hv_store(hash, "PATH", 4, newSVpv(path, 0), 0);

    /* Close our OggVorbis_File cause we don't want to keep the file
     * descriptor open.
     */
    ov_clear(&vf);
    
    /* Bless the hashref to create a class object */    
    sv_bless(obj_ref, gv_stashpv(class, FALSE));

    return obj_ref;
}

/* These comment manipulation functions use the vcedit library by 
 * Michael Smith.  They also borrow quite a bit from vorbiscomment
 * (vcomment.c) by Michael Smith and Ralph Giles.
 */
int write_vorbis (SV *obj)
{
    vcedit_state *state;
    vorbis_comment *vc;
    char *inpath, *outpath, *mvstring, *key, *val;
    FILE *fd, *fd2;
    HV *hash = (HV *) SvRV(obj);
    HV *chash;
    AV *vals;
    HE *hval;
    I32 i, j, num;

    /* Skip if comments hasn't been opened */
    if (! hv_exists(hash, "COMMENTS", 8)) {
        return 0;
    }

    /* Set up the input and output paths */
    inpath = strdup((char *) SvIV(*(hv_fetch(hash, "_PATH", 5, 0))));
    outpath = malloc(strlen(inpath) + (8 * sizeof(char)));
    strcpy(outpath, inpath);
    strcat(outpath, ".ovitmp");

    /* Open the files */
    if ((fd = fopen(inpath, "r")) == NULL) {
        perror("Error opening file in Ogg::Vorbis::Header::write\n");
        free(inpath);
        free(outpath);
        return 0;
    }

    if ((fd2 = fopen(outpath, "w+")) == NULL) {
        fclose(fd);
        free(inpath);
        free(outpath);
        perror("Error opening temp file in Ogg::Vorbis::Header::write\
+n");
        return 0;
    }

    /* Setup the state and comments structs */
    state = vcedit_new_state();
    if (vcedit_open(state, fd) < 0) {
        perror("Error opening stream in Ogg::Vorbis::Header::add_comme
+nt\n");
        goto cleanup;
    }
    vc = vcedit_comments(state);

    /* clear the old comment fields */
    vorbis_comment_clear(vc);
    vorbis_comment_init(vc);

    /* Write the comment fields from the hash
     * FIX: This doesn't preserve order, which may or may not be a pro
+blem
     */
    chash = (HV *) SvRV(*(hv_fetch(hash, "COMMENTS", 8, 0)));

    num = hv_iterinit(chash);
    for (i = 0; i < num; ++i) {
        hval = hv_iternext(chash);
        key = SvPV_nolen(hv_iterkeysv(hval));
        vals = (AV*) SvRV(*(hv_fetch(chash, key, strlen(key), 0)));
        for (j = 0; j <= av_len(vals); ++j) {
            val = SvPV_nolen(*av_fetch(vals, j, 0));
            vorbis_comment_add_tag(vc, key, val);
        }
    }
    
    /* Write out the new stream */
    if (vcedit_write(state, fd2) < 0) {
        perror("Error writing stream in Ogg::Vorbis::Header::add_comme
+nt\n");
        goto cleanup;
    }

    fclose(fd);
    fclose(fd2);
    vcedit_clear(state);
    mvstring = malloc(strlen(inpath) + strlen(outpath)
        + (5 * sizeof(char)));
    strcpy(mvstring, "mv ");
    strcat(mvstring, outpath);
    strcat(mvstring, " ");
    strcat(mvstring, inpath);
    unlink(inpath);
    system(mvstring);
    unlink(outpath);
    free(inpath);
    free(outpath);
    free(mvstring);


    return 1;
    
    cleanup:
        fclose(fd);
        fclose(fd2);
        unlink(outpath);
        free(inpath);
        free(outpath);
        vcedit_clear(state);
        return 0;
}
        
/* We strdup'd the internal path string so we need to free it */
void DESTROY (SV *obj)
{
    char *ptr;
    HV *hash = (HV *) SvRV(obj);

    ptr = (char *) SvIV(*(hv_fetch(hash, "_PATH", 5, 0)));
    free(ptr);
}
Replies are listed 'Best First'.
Re: Ogg::Vorbis::Info
by strider corinth (Friar) on Sep 27, 2002 at 17:45 UTC
    This module would be very useful to me. I've been needing a script to re-write the comments in a lot of my .ogg files in bulk, and I hate having to use system() and vorbiscomment.

    One thing I noticed in the Ogg::Vorbis documentation, in the Description section:
    The info() method returns an Ogg::Vorbis::Info object. You can access the various fields of the
    vorbis_info struct with methods of the same name.
    Their version doesn't let you modify the file, of course, but the name conflict seems like it might be a problem. Perhaps Ogg::Vorbis::Comment?

    --

    Love justice; desire mercy.
      Their version doesn't let you modify the file, of course, but the name conflict seems like it might be a problem. Perhaps Ogg::Vorbis::Comment?

      Good point, although comment might end up being just as ambiguous in the long run. How about Ogg::Vorbis::Header?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://200588]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-04-19 19:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found