File: FLAC.pm

package info (click to toggle)
lltag 0.14.4-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd, wheezy
  • size: 448 kB
  • ctags: 301
  • sloc: perl: 2,833; makefile: 120; sh: 17
file content (84 lines) | stat: -rw-r--r-- 2,160 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
package Lltag::FLAC ;

use strict ;

require Lltag::Tags ;
require Lltag::Misc ;

sub test_metaflac {
    my $self = shift ;
    # cannot test with "metaflac -h" since it returns 1
    my ($status, @output) = Lltag::Misc::system_with_output ("metaflac", "/dev/null") ;
    print "metaflac does not seem to work (is the 'flac' package installed?), disabling 'Flac' backend.\n"
	if $status and $self->{verbose_opt} ;
    return $status ;
}

sub read_tags {
    my $self = shift ;
    my $file = shift ;
    my ($status, @output) = Lltag::Misc::system_with_output
	("metaflac", "--list", "--block-type=VORBIS_COMMENT", $file) ;
    return undef
	if $status ;
    @output = map {
	my $line = $_ ;
	$line =~ s/^\s*comment\[\d+\]\s*:\s*(.*)/$1/ ;
	$line =~ s/^TRACKNUMBER=/NUMBER=/ ;
	$line
	} ( grep { /comment\[\d+\]/ } @output ) ;
    return Lltag::Tags::convert_tag_stream_to_values ($self, @output) ;
}

sub set_tags {
    my $self = shift ;
    my $file = shift ;
    my $values = shift ;

    my %field_name_flac_translations =
	(
	 'NUMBER'  => 'TRACKNUMBER',
	 ) ;
    my @flac_tagging_cmd = ( 'metaflac' ) ;
    my @flac_tagging_clear_option = ( '--remove-all-tags' ) ;

    my @system_args
	= ( @flac_tagging_cmd ,
	    # clear all tags
	    @flac_tagging_clear_option ,
	    # apply new tags
	    ( map {
		my $flacname = $_ ;
		$flacname = $field_name_flac_translations{$_} if defined $field_name_flac_translations{$_} ;
		my @tags = Lltag::Tags::get_tag_value_array ($self, $values, $_) ;
		map { ( "--set-tag", $flacname."=".$_ ) } @tags
		} @{$self->{field_names}}
	      ),
	    # apply non-regular tags
	    ( map {
		my $flacname = $_ ;
		my @tags = Lltag::Tags::get_tag_value_array ($self, $values, $_) ;
		map { ( "--set-tag", $flacname."=".$_ ) } @tags
		} Lltag::Tags::get_values_non_regular_keys ($self, $values)
	      ),
	    $file ) ;

    Lltag::Tags::set_tags_with_external_prog ($self, @system_args) ;
}

sub new {
    my $self = shift ;

    return undef
	if test_metaflac $self ;

    return {
	name => "Flac (using metaflac)",
	type => "flac",
	extension => "flac",
	read_tags => \&read_tags,
	set_tags => \&set_tags,
    } ;
}

1 ;