3 # Web Chord v1.1 - A CGI script to convert a ChordPro file to HTML
4 # Copyright 1998-2003 Martin Vilcans (martin@mamaviol.org)
7 # chopro - This parameter can be submitted by a form as a text field or file
11 # 1998-07-20 Version 1.0
12 # 2003-08-03 Version 1.1 Uses stylesheets
13 # 2014-02-05 Added things particular to my implementation of Songbook at
14 # http://defaria.com/songbook
19 use CGI qw(:standard);
20 use CGI::Carp qw (fatalsToBrowser);
23 my ($chopro, $output, $i);
25 my $documentRoot = "/web";
26 my $debug = param ('debug');
27 my $infile = param ('chordpro');
30 $infile = '/opt/clearscm/songbook/Songs/' . $infile;
33 print "Unable to $infile";
43 print "<font color=red><b>Debug:</b></font> $msg<br>";
53 print "<font color=orange><b>Warning</b></font> $msg<br>";
61 print "<html><head><title>Web Chord: Error</title></head>" .
62 "<body><h1>Error</h1><p>\n$msg\n</p>" .
68 sub musicFileExists ($) {
71 debug "ENTER musicFileExists ($song)";
73 my $title = fileparse ($song, qr/\.pro/);
74 my $musicfile = "/opt/clearscm/songbook/Media/$title.mp3";
81 debug "Could not find $musicfile";
87 sub updateMusicpath ($$) {
88 my ($chopro, $song) = @_;
90 my $title = musicFileExists $song;
92 # If there's no corresponding music file then do nothing
95 # If the .pro file already has musicpath then do nothing
96 if ($chopro =~ /\{musicpath:.*\}/) {
97 debug "$song already has musicpath";
100 return if $chopro =~ /\{musicpath:.*\}/;
102 # Otherwise append the musicpath
105 open $songfile, '>>', $song
108 unless (defined $songfile) {
109 my $msg = "Unable to open $song for append - $!<br>";
110 $msg .= "<br>Please notify <a href=\"mailto:adefaria\@gmail.com?subject=Please chmod 666 $song\">Andrew DeFaria</a> so this can be corrected.<br>";
111 $msg .= "<br>Thanks";
117 my $songbase = '/sdcard';
118 $songbase = '/storage/emulated/0';
120 print $songfile "{musicpath:$songbase/SongBook/Media/$title.mp3}\n";
127 # Outputs the HTML code of the chordpro file in the first parameter
128 sub chopro2html ($$) {
129 my ($chopro, $song) = @_;
131 $chopro =~ s/\</\</g; # replace < with <
132 $chopro =~ s/\>/\>/g; # replace > with >
133 $chopro =~ s/\&/\&/g; # replace & with &
137 if(($chopro =~ /^{title:(.*)}/mi) || ($chopro =~ /^{t:(.*)}/mi)) {
140 $title = "ChordPro song";
145 <title>$title</title>
146 <style type="text/css">
148 background-image: url('/songbook/background.jpg');
153 font-family: Arial, Helvetica;
159 font-family: Arial, Helvetica;
163 .lyrics, .lyrics_chorus {
166 .lyrics_tab, .lyrics_chorus_tab {
167 font-family: "Courier New", Courier;
170 .lyrics_chorus, .lyrics_chorus_tab, .chords_chorus, .chords_chorus_tab {
173 .chords, .chords_chorus, .chords_tab, .chords_chorus_tab {
178 .comment, .comment_italic {
183 background-color: #ffbbaa;
197 $title = musicFileExists $song;
200 updateMusicpath $chopro, $song;
204 <table border="0" width="100%">
207 <td align="left"><a href="/songbook"><img src="/Icons/Home.png" alt="Home"></a></td>
213 <audio controls autoplay>
214 <source src="http://defaria.com/Media/$title.mp3" type='audio/mp3'>
215 <p>Your user agent does not support the HTML5 Audio element.</p>
225 my $mode = 0; # mode defines which class to use
228 # normal chorus normal+tab chorus+tab
229 my @lClasses = ('lyrics', 'lyrics_chorus', 'lyrics_tab', 'lyrics_chorus_tab' );
230 my @cClasses = ('chords', 'chords_chorus', 'chords_tab', 'chords_chorus_tab' );
232 while($chopro ne '') {
233 $chopro =~ s/(.*)\n?//; # extract and remove first line
237 if(/^#(.*)/) { # a line starting with # is a comment
238 print "<!--$1-->\n"; # insert as HTML comment
239 } elsif(/{(.*)}/) { # this is a command
241 if(/^title:/i || /^t:/i) { # title
242 print "<H1>$'</H1>\n";
243 } elsif(/^subtitle:/i || /^st:/i) { # subtitle
244 print "<H2>$'</H2>\n";
245 } elsif(/^start_of_chorus/i || /^soc/i) { # start_of_chorus
247 } elsif(/^end_of_chorus/i || /^eoc/i) { # end_of_chorus
249 } elsif(/^comment:/i || /^c:/i) { # comment
250 print "<span class=\"comment\">($')</span>\n";
251 } elsif(/^comment_italic:/i || /^ci:/i) { # comment_italic
252 print "<span class=\"comment_italic\">($')</span>\n";
253 } elsif(/^comment_box:/i || /^cb:/i) { # comment_box
254 print "<P class=\"comment_box\">$'</P>\n";
255 } elsif(/^start_of_tab/i || /^sot/i) { # start_of_tab
257 } elsif(/^end_of_tab/i || /^eot/i) { # end_of_tab
260 print "<!--Unsupported command: $_-->\n";
262 } else { # this is a line with chords and lyrics
266 s/\s/\ /g; # replace spaces with hard spaces
267 while(s/(.*?)\[(.*?)\]//) {
269 push(@chords,$2 eq '\'|' ? '|' : $2);
271 push(@lyrics,$_); # rest of line (after last chord) into @lyrics
273 if($lyrics[0] eq "") { # line began with a chord
274 shift(@chords); # remove first item
275 shift(@lyrics); # (they are both empty)
278 if(@lyrics==0) { # empty line?
280 } elsif(@lyrics==1 && $chords[0] eq "") { # line without chords
281 print "<DIV class=\"$lClasses[$mode]\">$lyrics[0]</DIV>\n";
283 print "<TABLE cellpadding=0 cellspacing=0>";
286 for($i = 0; $i < @chords; $i++) {
287 print "<TD class=\"$cClasses[$mode]\">$chords[$i]</TD>";
289 print "</TR>\n<TR>\n";
290 for($i = 0; $i < @lyrics; $i++) {
291 print "<TD class=\"$lClasses[$mode]\">$lyrics[$i]</TD>";
293 print "</TR></TABLE>\n";
303 error "No chordpro parameter";
306 open my $file, '<', $infile
307 or error "Unable to open file $infile - $!";
314 chopro2html ($chopro, $infile);