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