File Coverage

blib/lib/Music/ABC/Song.pm

Criterion	Covered	Total	%
statement	66	163	40.4
branch	13	70	18.5
condition	3	15	20.0
subroutine	9	23	39.1
pod	14	18	77.7
total	105	289	36.3

package Music::ABC::Song;

use 5.008;
use strict;
use warnings;
use Carp ;

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = () ;
our @EXPORT_OK = ();

our $VERSION = '0.01';


my %new_attributes = (archivename=>1, number => 1, meter=>1, type=>1, key=>1, filepos=>1) ;

my %header_full = (
A=>"AREA",
B=>"BOOK",
C=>"COMPOSER",
D=>"DISCOGRAPHY",
E=>"ELEMSKIP",
F=>"FILENAME",
G=>"GROUP",
H=>"HISTORY",
I=>"INFORMATION",
K=>"KEY",
L=>"NOTELENGTH",
M=>"METER",
N=>"NOTES",
O=>"ORIGIN",
P=>"PARTS",
Q=>"TEMPO",
R=>"RHYTHM",
S=>"SOURCE",
T=>"TITLES",
X=>"NUMBER",
Z=>"TRANSCRIPTION") ;

my %header_is_multiline = (DISCOGRAPHY=>1,HISTORY=>1,INFORMATION=>1,NOTES=>1,TITLES=>1,TRANSCRIPTION=>1) ;

my @header_print_order = qw(TITLES RHYTHM KEY METER NOTES HISTORY DISCOGRAPHY INFORMATION TRANSCRIPTION) ;

sub new
{
    my ($caller, %args) = @_ ;
    my $self = bless {}, ref($caller) || $caller ;

    $self->{ARCHIVENAME} = "" ;
    $self->{DISPLAY_NAME} = "" ;
    $self->{NUMBER} = 0 ;
    $self->{FILEPOS} = 0 ;
    $self->{TEXT} = [] ;

    $self->{AREA} = "" ;
    $self->{BOOK} = "" ;
    $self->{COMPOSER} = "" ;
    $self->{DISCOGRAPHY} = [] ;
    $self->{ELEMSKIP} = "" ;
    $self->{GROUP} = "" ;
    $self->{HISTORY} = [] ;
    $self->{INFORMATION} = [] ;
    $self->{KEY} = "" ;
    $self->{NOTELENGTH} = "" ;
    $self->{METER} = "" ;
    $self->{NOTES} = [] ;
    $self->{ORIGIN} = "" ;
    $self->{PARTS} = "" ;
    $self->{TEMPO} = "" ;
    $self->{RHYTHM} = "" ;
    $self->{SOURCE} = "" ;
    $self->{TITLES} = [] ;
    $self->{TRANSCRIPTION} = [] ;


    while (my ($arg, $value) = each %args) {
	croak "Invalid intializer for Music::ABC::Song object" unless $new_attributes{$arg} ;
	no strict 'refs' ;
	$self->$arg($value) ;
    }

    return $self ;
}

sub quote_html
{
    my $text = shift ;

    $text =~ s/&/&/g ;
    $text =~ s/
    $text =~ s/>/>/g ;
    $text =~ s/"/&qout;/g ;

    return $text ;
}

sub output_scalar_desc
{
    my $header_str = shift ;
    my $text = shift ;
    my $html_tag = shift || 0 ;
    my $use_tags = shift || 0 ;
    my @data = () ;
    my $tmp ;

    $tmp .= "<$html_tag>" if ($use_tags) ;
    $tmp .= "$header_str" if $header_str ;
    $tmp .= "" if ($use_tags) ;
    $text = quote_html($text) if($use_tags) ;
    $tmp .= " $text" ;
    $tmp .= "" if ($use_tags) ;
    $tmp .= "" if($use_tags) ;
    push (@data, $tmp) ;
    return @data ;
}

sub output_array_desc
{
    my $header_str = shift ;
    my $text_aref = shift ;
    my $html_tag = shift || 0 ;
    my $use_tags = shift || 0 ;
    my @data ;
    my $indent = " " x 8 ;

    push (@data, "<$html_tag>") if($use_tags) ;
    my $tmp .= "$header_str " if $header_str ;
    push (@data, $tmp) ;

    foreach(@$text_aref) {
	$tmp = $use_tags ? "" : "" ;
	$tmp .= $use_tags ? quote_html($_) : $_ ;
	$tmp .= $use_tags ? "" : "" ;
	push (@data, $indent . $tmp) ;
    }
    push (@data, "") if($use_tags) ;
    return @data ;
}

sub get_song_summary
{
    my $self = shift ;
    my $use_html_tags = shift || 0 ;
    my @data ;
    my $indent = " " x 8 ;

    my $tmp = "" if $use_html_tags ;
    $tmp .= "Song Number $self->{NUMBER} in " . $self->{ARCHIVENAME} ;
    $tmp .= "" if $use_html_tags ;

    push(@data, $tmp) ;

    foreach(@header_print_order) {
	my $multiline = $header_is_multiline{$_} ;
	if($multiline) {
	    push(@data, output_array_desc($_, \@{$self->{$_}}, "dl", $use_html_tags)) ;
	} else {
	    push(@data, output_scalar_desc($_, $self->{$_}, "dl", $use_html_tags)) ;
	}
    }

    return @data ;
}

sub archivename
{
    my $self = shift ;
    $self->{ARCHIVENAME} = shift if @_ ;
    return $self->{ARCHIVENAME} ;
}

sub filepos
{
    my $self = shift ;
    $self->{FILEPOS} = shift if @_ ;
    return $self->{FILEPOS} ;
}

sub number
{
    my $self = shift ;
    $self->{NUMBER} = shift if @_ ;
    return $self->{NUMBER} ;
}

sub type
{
    my $self = shift ;
    $self->{TYPE} = shift if @_ ;
    return $self->{TYPE} ;
}

sub key
{
    my $self = shift ;
    $self->{KEY} = shift if @_ ;
    return $self->{KEY} ;
}

sub meter
{
    my $self = shift ;
    $self->{METER} = shift if @_ ;
    return $self->{METER} ;
}

sub display_name
{
    my $self = shift ;
    $self->{DISPLAY_NAME} = shift if @_ ;
    return $self->{DISPLAY_NAME} ;
}

sub titles {
    my $self = shift ;

    if(@_) {
	if (ref $_[0] eq 'ARRAY') {
	    @{ $self->{TITLES} } = @{ $_[0] } ;
	} else {
	    @{ $self->{TITLES} } = @_ ;
	}
    }

    return $self->{TITLES} ;
}

sub add_title {
    my $self = shift ;
    push (@{ $self->{TITLES} }, shift) if @_ ;
    return $self->{TITLES}
}

sub notes {
    my $self = shift ;

    if(@_) {
	if (ref $_[0] eq 'ARRAY') {
	    @{ $self->{NOTES} } = @{ $_[0] } ;
	} else {
	    @{ $self->{NOTES} } = @_ ;
	}
    }

    return $self->{NOTES} ;
}

sub add_note {
    my $self = shift ;
    push (@{ $self->{NOTES} }, shift) if @_ ;
    return $self->{NOTES} ;
}

sub text {
    my $self = shift ;
    push (@{ $self->{TEXT} }, shift) if @_ ;
    return $self->{TEXT} ;
}

sub header {
    my $self = shift ;
    my $header_code = shift ;
    my $header_text = shift ;
    my $header_name = $header_full{$header_code} ;

    if($header_name) {
	my $multiline = $header_is_multiline{$header_name} || 0 ;
	if($multiline) {
	    if($header_text) {
		push (@{ $self->{$header_name} }, $header_text) if $header_text ;
	    }
	    return \@{ $self->{$header_name} } ;
	} else {
	    if($header_text) {
		$self->{$header_name} = $header_text ;
	    }
	    return $self->{$header_name} ;
	}
    }
}

1;
__END__