songbook/web/webchord.cgi

   1 #!/usr/bin/perl
   2
   3 # Web Chord v1.1 - A CGI script to convert a ChordPro file to HTML
   4 # Copyright 1998-2003 Martin Vilcans (martin@mamaviol.org)
   5 #
   6 # CGI parameters:
   7 #  chopro - This parameter can be submitted by a form   as a text field or file
   8 #           upload.
   9 #
  10 # History:
  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
  15
  16 use strict;
  17 use warnings;
  18
  19 use CGI qw(:standard);
  20 use CGI::Carp qw (fatalsToBrowser);
  21 use File::Basename;
  22
  23 my ($chopro, $output, $i);
  24
  25 my $documentRoot = "/web";
  26 my $debug        = param ('debug');
  27 my $infile       = param ('chordpro');
  28
  29
  30 sub debug ($) {
  31   my ($msg) = @_;
  32
  33   return unless $debug;
  34
  35   print "<font color=red><b>Debug:</b></font> $msg<br>";
  36
  37   return;
  38 } # debug
  39
  40 sub warning ($) {\r
  41   my ($msg) = @_;
  42
  43   debug "warning";
  44
  45   print "<font color=orange><b>Warning</b></font> $msg<br>";
  46
  47   return;
  48 } # warning
  49
  50 sub error {
  51   my ($msg) = @_;
  52
  53   print "<html><head><title>Web Chord: Error</title></head>" .
  54     "<body><h1>Error</h1><p>\n$msg\n</p>" .
  55     "</body></html>";
  56
  57   exit;
  58 } # error
  59
  60 sub musicFileExists ($) {
  61   my ($song) = @_;
  62
  63   debug "ENTER musicFileExists ($song)";
  64
  65   my $title     = fileparse ($song, qr/\.pro/);
  66   my $musicfile = "/songbook/Media/$title.mp3";
  67
  68   if (-r "$documentRoot$musicfile") {
  69     debug "Exists!";
  70
  71     return $title;
  72   } else {
  73     debug "Could not find $documentRoot$musicfile";
  74
  75     return undef;
  76   } # if
  77 } # musicFileExists
  78
  79 sub updateMusicpath ($$) {
  80   my ($chopro, $song) = @_;
  81
  82   my $title = musicFileExists $song;
  83
  84   # If there's no corresponding music file then do nothing
  85   return unless $title;
  86
  87   # If the .pro file already has musicpath then do nothing
  88   if ($chopro =~ /\{musicpath:.*\}/) {
  89     debug "$song already has musicpath";
  90   } # if
  91
  92   return if $chopro =~ /\{musicpath:.*\}/;
  93
  94   # Otherwise append the musicpath
  95   my $songfile;
  96
  97   open $songfile, '>>', $song
  98     or undef $songfile;
  99
 100   unless (defined $songfile) {
 101     my $msg  = "Unable to open $song for append - $!<br>";
 102        $msg .= "<br>Please notify <a href=\"mailto:adefaria\@gmail.com?subject=Please chmod 666 $song\">Andrew DeFaria</a> so this can be corrected.<br>";
 103        $msg .= "<br>Thanks";
 104     warning $msg;
 105
 106     return;
 107   } # unless
 108
 109   my $songbase = '/sdcard';
 110   $songbase = '/storage/emulated/0';
 111
 112   print $songfile "{musicpath:$songbase/SongBook/Media/$title.mp3}\n";
 113
 114   close $songfile;
 115
 116   return;
 117 } # updateMusicPath
 118
 119 # Outputs the HTML code of the chordpro file in the first parameter
 120 sub chopro2html ($$) {
 121   my ($chopro, $song) = @_;
 122
 123   $chopro =~ s/\</\&lt;/g; # replace < with &lt;
 124   $chopro =~ s/\>/\&gt;/g; # replace > with &gt;
 125   $chopro =~ s/\&/\&amp;/g; # replace & with &amp;
 126
 127   my $title;
 128
 129   if(($chopro =~ /^{title:(.*)}/mi) || ($chopro =~ /^{t:(.*)}/mi)) {
 130     $title = $1;
 131   } else {
 132     $title = "ChordPro song";
 133   }
 134   print <<END;
 135 <html>
 136 <head>
 137 <title>$title</title>
 138 <style type="text/css">
 139 body {
 140   background-image: url('/songbook/background.jpg');
 141   padding-left: 100px;
 142 }
 143 h1 {
 144   text-align: center;
 145   font-family: Arial, Helvetica;
 146   font-size: 24;
 147   line-height: 10%;
 148 }
 149 h2 {
 150   text-align: center;
 151   font-family: Arial, Helvetica;
 152   font-size: 18;
 153   line-height: 50%;
 154 }
 155 .lyrics, .lyrics_chorus {
 156   font-size: 10pt;
 157 }
 158 .lyrics_tab, .lyrics_chorus_tab {
 159   font-family: "Courier New", Courier;
 160   font-size: 10pt;
 161 }
 162 .lyrics_chorus, .lyrics_chorus_tab, .chords_chorus, .chords_chorus_tab {
 163   font-weight: bold;
 164 }
 165 .chords, .chords_chorus, .chords_tab, .chords_chorus_tab {
 166   font-size: 10pt;
 167   color: blue;
 168   padding-right: 4pt;
 169 }
 170 .comment, .comment_italic {
 171   color: #999;
 172   font-size: 10pt;
 173 }
 174 .comment_box {
 175   background-color: #ffbbaa;
 176   text-align: center;
 177 }
 178 .comment_italic {
 179   font-style: italic;
 180 }
 181 .comment_box {
 182   border: solid;
 183 }
 184 </style>
 185 </head>
 186 <body>
 187 END
 188
 189       $title = musicFileExists $song;
 190
 191       if ($title) {
 192         updateMusicpath $chopro, $song;
 193       } # if
 194
 195       print << "END";
 196 <table border="0" width="100%">
 197   <tbody>
 198     <tr>
 199       <td align="left"><a href="/songbook"><img src="/Icons/Home.png" alt="Home"></a></td>
 200 END
 201
 202       if ($title) {
 203         print <<"END";
 204 <td align="right">
 205 <audio controls autoplay>
 206  <source src="http://defaria.com/songbook/Media/$title.mp3" type='audio/mp3'>
 207  <p>Your user agent does not support the HTML5 Audio element.</p>
 208 </audio>
 209 </td>
 210 END
 211       } # if
 212 print <<"END";
 213     </tr>
 214   </tbody>
 215 </table>
 216 END
 217   my $mode = 0; # mode defines which class to use
 218
 219   #mode =           0           1              2             3
 220   #       normal      chorus         normal+tab    chorus+tab
 221   my @lClasses = ('lyrics', 'lyrics_chorus', 'lyrics_tab', 'lyrics_chorus_tab'  );
 222   my @cClasses = ('chords', 'chords_chorus', 'chords_tab', 'chords_chorus_tab'  );
 223
 224   while($chopro ne '') {
 225     $chopro =~ s/(.*)\n?//; # extract and remove first line
 226     $_ = $1;
 227     chomp;
 228
 229     if(/^#(.*)/) {                                # a line starting with # is a comment
 230       print "<!--$1-->\n";                        # insert as HTML comment
 231     } elsif(/{(.*)}/) {                           # this is a command
 232       $_ = $1;
 233       if(/^title:/i || /^t:/i) {                  # title
 234         print "<H1>$'</H1>\n";
 235       } elsif(/^subtitle:/i || /^st:/i) {         # subtitle
 236         print "<H2>$'</H2>\n";
 237       } elsif(/^start_of_chorus/i || /^soc/i) {   # start_of_chorus
 238         $mode |= 1;
 239       } elsif(/^end_of_chorus/i || /^eoc/i) {     # end_of_chorus
 240         $mode &= ~1;
 241       } elsif(/^comment:/i || /^c:/i) {           # comment
 242         print "<span class=\"comment\">($')</span>\n";
 243       } elsif(/^comment_italic:/i || /^ci:/i) {   # comment_italic
 244         print "<span class=\"comment_italic\">($')</span>\n";
 245       } elsif(/^comment_box:/i || /^cb:/i) {      # comment_box
 246         print "<P class=\"comment_box\">$'</P>\n";
 247       } elsif(/^start_of_tab/i || /^sot/i) {      # start_of_tab
 248         $mode |= 2;
 249       } elsif(/^end_of_tab/i || /^eot/i) {        # end_of_tab
 250         $mode &= ~2;
 251       } else {
 252         print "<!--Unsupported command: $_-->\n";
 253       }
 254     } else { # this is a line with chords and lyrics
 255       my(@chords,@lyrics);
 256       @chords=("");
 257       @lyrics=();
 258       s/\s/\&nbsp;/g;         # replace spaces with hard spaces
 259       while(s/(.*?)\[(.*?)\]//) {
 260         push(@lyrics,$1);
 261         push(@chords,$2 eq '\'|' ? '|' : $2);
 262       }
 263       push(@lyrics,$_);       # rest of line (after last chord) into @lyrics
 264
 265       if($lyrics[0] eq "") {  # line began with a chord
 266         shift(@chords);       # remove first item
 267         shift(@lyrics);       # (they are both empty)
 268       }
 269
 270       if(@lyrics==0) {  # empty line?
 271         print "<BR>\n";
 272       } elsif(@lyrics==1 && $chords[0] eq "") { # line without chords
 273         print "<DIV class=\"$lClasses[$mode]\">$lyrics[0]</DIV>\n";
 274       } else {
 275         print "<TABLE cellpadding=0 cellspacing=0>";
 276         print "<TR>\n";
 277         my($i);
 278         for($i = 0; $i < @chords; $i++) {
 279           print "<TD class=\"$cClasses[$mode]\">$chords[$i]</TD>";
 280         }
 281         print "</TR>\n<TR>\n";
 282         for($i = 0; $i < @lyrics; $i++) {
 283           print "<TD class=\"$lClasses[$mode]\">$lyrics[$i]</TD>";
 284         }
 285         print "</TR></TABLE>\n";
 286       } # if
 287     } # if
 288   } # while
 289 } # chordpro2html
 290
 291 ## Main
 292 print header;
 293
 294 unless ($infile) {
 295         error "No chordpro parameter";
 296 } # unless
 297
 298 open my $file, '<', $infile
 299   or error "Unable to open file $infile - $!";
 300
 301 {
 302   local $/;
 303   $chopro = <$file>;
 304 }
 305
 306 chopro2html ($chopro, $infile);
 307
 308 print end_html();
 309
 310 exit;
 311
 312