#!/usr/bin/perl # Web Chord v1.1 - A CGI script to convert a ChordPro file to HTML # Copyright 1998-2003 Martin Vilcans (martin@mamaviol.org) # # CGI parameters: # chopro - This parameter can be submitted by a form as a text field or file # upload. # # History: # 1998-07-20 Version 1.0 # 2003-08-03 Version 1.1 Uses stylesheets # 2014-02-05 Added things particular to my implementation of Songbook at # http://defaria.com/songbook use strict; use warnings; use CGI qw(:standard); use CGI::Carp qw (fatalsToBrowser); use File::Basename; my ($chopro, $i); my $documentRoot = "/web"; my $debug = param ('debug'); my $infile = param ('chordpro'); unless (-f $infile) { $infile = '/opt/songbook/Andrew/' . $infile; unless (-f $infile) { $infile = '/web/xmas/' . param ('chordpro'); unless (-f $infile) { print "Unable to open $infile"; exit 1; } # unless } # unless } # unless sub debug ($) { my ($msg) = @_; return unless $debug; print "Debug: $msg
"; return; } # debug sub warning ($) { my ($msg) = @_; debug "warning"; print "Warning $msg
"; return; } # warning sub error { my ($msg) = @_; print "Web Chord: Error" . "

Error

\n$msg\n

" . ""; exit; } # error sub getTitle ($) { my ($song) = @_; return fileparse ($song, qr/\.pro/); } # getTitle sub musicFileExists ($) { my ($song) = @_; debug "ENTER musicFileExists ($song)"; my $title = getTitle ($song); my $musicfile = "/opt/media/$title.mp3"; return -r $musicfile; } # musicFileExists sub updateMusicpath ($$) { my ($chopro, $song) = @_; # If there's no corresponding music file then do nothing return unless musicFileExists $song; # If the .pro file already has musicpath then do nothing return if $chopro =~ /\{musicpath:.*\}/; # Otherwise append the musicpath my $songfile; open $songfile, '>>', $song or undef $songfile; unless (defined $songfile) { my $msg = "Unable to open $song for append - $!
"; $msg .= "
Please notify Andrew DeFaria so this can be corrected.
"; $msg .= "
Thanks"; warning $msg; return; } # unless my $songbase = '/sdcard'; my $title = getTitle $song; print $songfile "{musicpath:$songbase/SongBook/Media/$title.mp3}\n"; close $songfile; return; } # updateMusicPath # Outputs the HTML code of the chordpro file in the first parameter sub chopro2html ($$) { my ($chopro, $song) = @_; $chopro =~ s/\/\>/g; # replace > with > $chopro =~ s/\&/\&/g; # replace & with & my $title = "ChordPro Song"; my $artist = "Unknown"; if (($chopro =~ /^{title:(.*)}/mi) || ($chopro =~ /^{t:(.*)}/mi)) { $title = $1; } # if if (($chopro =~ /^{subtitle:(.*)}/mi) || ($chopro =~ /^{st:(.*)}/mi)) { $artist = $1; } # if print <<"END"; $title END $title = getTitle $song; if ($title) { updateMusicpath $chopro, $song; } # if my $titleLink = "$title"; print << "END";

Home

$titleLink

Mark A: not set Mark B: not set

END my $mode = 0; # mode defines which class to use #mode = 0 1 2 3 # normal chorus normal+tab chorus+tab my @lClasses = ('lyrics', 'lyrics_chorus', 'lyrics_tab', 'lyrics_chorus_tab' ); my @cClasses = ('chords', 'chords_chorus', 'chords_tab', 'chords_chorus_tab' ); while($chopro ne '') { $chopro =~ s/(.*)\n?//; # extract and remove first line $_ = $1; chomp; if (/^#(.*)/) { # a line starting with # is a comment print "\n"; # insert as HTML comment } elsif (/{(.*)}/) { # this is a command $_ = $1; if (/^start_of_chorus/i || /^soc/i) { # start_of_chorus $mode |= 1; } elsif (/^end_of_chorus/i || /^eoc/i) { # end_of_chorus $mode &= ~1; } elsif (/^comment:/i || /^c:/i) { # comment print "($')\n"; } elsif (/^comment_italic:/i || /^ci:/i) { # comment_italic print "($')\n"; } elsif (/^comment_box:/i || /^cb:/i) { # comment_box print "

$'

\n"; } elsif (/^start_of_tab/i || /^sot/i) { # start_of_tab $mode |= 2; } elsif (/^end_of_tab/i || /^eot/i) { # end_of_tab $mode &= ~2; } else { print "\n"; } } else { # this is a line with chords and lyrics my(@chords,@lyrics); @chords=(""); @lyrics=(); s/\s/\ /g; # replace spaces with hard spaces while(s/(.*?)\[(.*?)\]//) { push(@lyrics,$1); push(@chords,$2 eq '\'|' ? '|' : $2); } push(@lyrics,$_); # rest of line (after last chord) into @lyrics if ($lyrics[0] eq "") { # line began with a chord shift(@chords); # remove first item shift(@lyrics); # (they are both empty) } if (@lyrics==0) { # empty line? print "
\n"; } elsif (@lyrics==1 && $chords[0] eq "") { # line without chords print "

$lyrics[0]

\n"; } else { print ""; print "\n"; for(my $i = 0; $i < @chords; $i++) { print ""; } print "\n\n"; for($i = 0; $i < @lyrics; $i++) { print ""; } print "

$chords[$i]

$lyrics[$i]

\n"; } # if } # if } # while print "

"; } # chordpro2html ## Main print header; unless ($infile) { error "No chordpro parameter"; } # unless open my $file, '<', $infile or error "Unable to open file $infile - $!"; { local $/; $chopro = <$file>; } chopro2html ($chopro, $infile); print end_html(); exit;