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