lib/ID3FS/AudioFile/Ogg.pm

   1 package ID3FS::AudioFile::Ogg;
   2
   3 use strict;
   4 use warnings;
   5 use Ogg::Vorbis::Header;
   6
   7 sub new
   8 {
   9     my $proto=shift;
  10     my $class=ref($proto) || $proto;
  11     my $self={};
  12     bless($self,$class);
  13
  14     $self->{path}=shift;
  15     $self->{ogg}=Ogg::Vorbis::Header->new($self->{path});
  16     $self->{comments}=[ $self->{ogg}->comment_tags() ];
  17     return $self;
  18 }
  19
  20 sub get
  21 {
  22     my ($self, $tag, $complain)=@_;
  23     for my $commenttype (@{$self->{comments}})
  24     {
  25         if($commenttype =~ /$tag/i)
  26         {
  27             my @comments=$self->{ogg}->comment($commenttype);
  28             if(@comments)
  29             {
  30                 # take first comment with actual contents
  31                 while(my $comment=shift @comments)
  32                 {
  33                     if(defined($comment) &&
  34                        length($comment)  &&
  35                        $comment =~ /\S+/)
  36                     {
  37                         $comment =~ s/\//-/g; # drop slashes
  38                         return $comment;
  39                     }
  40                 }
  41             }
  42         }
  43     }
  44     warn("$self->{path}: no $tag defined in Ogg comments\n") if($complain);
  45     return undef;
  46 }
  47
  48 sub artist    { shift->get("Artist", 1); }
  49 sub album     { shift->get("Album", 1);  }
  50 sub audiotype { return "ogg";            }
  51 sub haspic    { return undef;            } # FIXME
  52 sub v1genre   { return undef;            } # ID3 only
  53
  54 # We don't care if year is not set
  55 sub year
  56 {
  57     my ($self)=@_;
  58     my $date=shift->get("Date", 0);
  59     return undef unless($date);
  60     if($date =~/(\d\d\d\d)/)
  61     {
  62         $date=$1;
  63     }
  64     return $date;
  65 }
  66
  67 sub tags
  68 {
  69     my $self=shift;
  70     my @comments;
  71     for my $commenttype (@{$self->{comments}})
  72     {
  73         if($commenttype =~ /genre/i)
  74         {
  75             push(@comments,$self->{ogg}->comment($commenttype));
  76         }
  77     }
  78     my $tags={};
  79     if(@comments)
  80     {
  81         # filter for useful comments
  82         @comments= grep { defined($_); } @comments;
  83         @comments= grep { length($_); }  @comments;
  84         @comments= grep { /\S+/; }       @comments;
  85         # combine then split on commas
  86         # so multiple comma-delimited tags will work
  87         @comments=split(/\s*,\s*/, join(', ', @comments));
  88         for my $comment (@comments)
  89         {
  90             if($comment=~/([^\/]+)\/(.*)/)
  91             {
  92                 my $tagname=$1;
  93                 my $tagval=$2;
  94                 $tagval=~s/\//-/g;
  95                 $tags->{$tagname}=$tagval;
  96             }
  97             else
  98             {
  99                 $tags->{$comment}=undef;
 100             }
 101         }
 102     }
 103     return $tags;
 104 }
 105
 106 1;
 107