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 unless (-f $infile) {
  30   $infile = '/opt/clearscm/songbook/Songs/' . $infile;
  31
  32   unless (-f $infile) {
  33     print "Unable to $infile";
  34     exit 1;
  35   } # unless
  36 } # unless
  37
  38 sub debug ($) {
  39   my ($msg) = @_;
  40
  41   return unless $debug;
  42
  43   print "<font color=red><b>Debug:</b></font> $msg<br>";
  44
  45   return;
  46 } # debug
  47
  48 sub warning ($) {\r
  49   my ($msg) = @_;
  50
  51   debug "warning";
  52
  53   print "<font color=orange><b>Warning</b></font> $msg<br>";
  54
  55   return;
  56 } # warning
  57
  58 sub error {
  59   my ($msg) = @_;
  60
  61   print "<html><head><title>Web Chord: Error</title></head>" .
  62     "<body><h1>Error</h1><p>\n$msg\n</p>" .
  63     "</body></html>";
  64
  65   exit;
  66 } # error
  67
  68 sub musicFileExists ($) {
  69   my ($song) = @_;
  70
  71   debug "ENTER musicFileExists ($song)";
  72
  73   my $title     = fileparse ($song, qr/\.pro/);
  74   my $musicfile = "/opt/clearscm/songbook/Media/$title.mp3";
  75
  76   if (-r $musicfile) {
  77     debug "Exists!";
  78
  79     return $title;
  80   } else {
  81     debug "Could not find $musicfile";
  82
  83     return undef;
  84   } # if
  85 } # musicFileExists
  86
  87 sub updateMusicpath ($$) {
  88   my ($chopro, $song) = @_;
  89
  90   my $title = musicFileExists $song;
  91
  92   # If there's no corresponding music file then do nothing
  93   return unless $title;
  94
  95   # If the .pro file already has musicpath then do nothing
  96   if ($chopro =~ /\{musicpath:.*\}/) {
  97     debug "$song already has musicpath";
  98   } # if
  99
 100   return if $chopro =~ /\{musicpath:.*\}/;
 101
 102   # Otherwise append the musicpath
 103   my $songfile;
 104
 105   open $songfile, '>>', $song
 106     or undef $songfile;
 107
 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";
 112     warning $msg;
 113
 114     return;
 115   } # unless
 116
 117   my $songbase = '/sdcard';
 118   $songbase = '/storage/emulated/0';
 119
 120   print $songfile "{musicpath:$songbase/SongBook/Media/$title.mp3}\n";
 121
 122   close $songfile;
 123
 124   return;
 125 } # updateMusicPath
 126
 127 # Outputs the HTML code of the chordpro file in the first parameter
 128 sub chopro2html ($$) {
 129   my ($chopro, $song) = @_;
 130
 131   $chopro =~ s/\</\&lt;/g; # replace < with &lt;
 132   $chopro =~ s/\>/\&gt;/g; # replace > with &gt;
 133   $chopro =~ s/\&/\&amp;/g; # replace & with &amp;
 134
 135   my $title;
 136
 137   if(($chopro =~ /^{title:(.*)}/mi) || ($chopro =~ /^{t:(.*)}/mi)) {
 138     $title = $1;
 139   } else {
 140     $title = "ChordPro song";
 141   }
 142   print <<END;
 143 <html>
 144 <head>
 145 <title>$title</title>
 146 <style type="text/css">
 147 body {
 148   background-image: url('/songbook/background.jpg');
 149   padding-left: 100px;
 150 }
 151 h1 {
 152   text-align: center;
 153   font-family: Arial, Helvetica;
 154   font-size: 24;
 155   line-height: 10%;
 156 }
 157 h2 {
 158   text-align: center;
 159   font-family: Arial, Helvetica;
 160   font-size: 18;
 161   line-height: 50%;
 162 }
 163 .lyrics, .lyrics_chorus {
 164   font-size: 10pt;
 165 }
 166 .lyrics_tab, .lyrics_chorus_tab {
 167   font-family: "Courier New", Courier;
 168   font-size: 10pt;
 169 }
 170 .lyrics_chorus, .lyrics_chorus_tab, .chords_chorus, .chords_chorus_tab {
 171   font-weight: bold;
 172 }
 173 .chords, .chords_chorus, .chords_tab, .chords_chorus_tab {
 174   font-size: 10pt;
 175   color: blue;
 176   padding-right: 4pt;
 177 }
 178 .comment, .comment_italic {
 179   color: #999;
 180   font-size: 10pt;
 181 }
 182 .comment_box {
 183   background-color: #ffbbaa;
 184   text-align: center;
 185 }
 186 .comment_italic {
 187   font-style: italic;
 188 }
 189 .comment_box {
 190   border: solid;
 191 }
 192 </style>
 193 </head>
 194 <body>
 195 END
 196
 197       $title = musicFileExists $song;
 198
 199       if ($title) {
 200         updateMusicpath $chopro, $song;
 201       } # if
 202
 203       print << "END";
 204 <table border="0" width="100%">
 205   <tbody>
 206     <tr>
 207       <td align="left"><a href="/songbook"><img src="/Icons/Home.png" alt="Home"></a></td>
 208 END
 209
 210       if ($title) {
 211         print <<"END";
 212 <td align="right">
 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>
 216 </audio>
 217 </td>
 218 END
 219       } # if
 220 print <<"END";
 221     </tr>
 222   </tbody>
 223 </table>
 224 END
 225   my $mode = 0; # mode defines which class to use
 226
 227   #mode =           0           1              2             3
 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'  );
 231
 232   while($chopro ne '') {
 233     $chopro =~ s/(.*)\n?//; # extract and remove first line
 234     $_ = $1;
 235     chomp;
 236
 237     if(/^#(.*)/) {                                # a line starting with # is a comment
 238       print "<!--$1-->\n";                        # insert as HTML comment
 239     } elsif(/{(.*)}/) {                           # this is a command
 240       $_ = $1;
 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
 246         $mode |= 1;
 247       } elsif(/^end_of_chorus/i || /^eoc/i) {     # end_of_chorus
 248         $mode &= ~1;
 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
 256         $mode |= 2;
 257       } elsif(/^end_of_tab/i || /^eot/i) {        # end_of_tab
 258         $mode &= ~2;
 259       } else {
 260         print "<!--Unsupported command: $_-->\n";
 261       }
 262     } else { # this is a line with chords and lyrics
 263       my(@chords,@lyrics);
 264       @chords=("");
 265       @lyrics=();
 266       s/\s/\&nbsp;/g;         # replace spaces with hard spaces
 267       while(s/(.*?)\[(.*?)\]//) {
 268         push(@lyrics,$1);
 269         push(@chords,$2 eq '\'|' ? '|' : $2);
 270       }
 271       push(@lyrics,$_);       # rest of line (after last chord) into @lyrics
 272
 273       if($lyrics[0] eq "") {  # line began with a chord
 274         shift(@chords);       # remove first item
 275         shift(@lyrics);       # (they are both empty)
 276       }
 277
 278       if(@lyrics==0) {  # empty line?
 279         print "<BR>\n";
 280       } elsif(@lyrics==1 && $chords[0] eq "") { # line without chords
 281         print "<DIV class=\"$lClasses[$mode]\">$lyrics[0]</DIV>\n";
 282       } else {
 283         print "<TABLE cellpadding=0 cellspacing=0>";
 284         print "<TR>\n";
 285         my($i);
 286         for($i = 0; $i < @chords; $i++) {
 287           print "<TD class=\"$cClasses[$mode]\">$chords[$i]</TD>";
 288         }
 289         print "</TR>\n<TR>\n";
 290         for($i = 0; $i < @lyrics; $i++) {
 291           print "<TD class=\"$lClasses[$mode]\">$lyrics[$i]</TD>";
 292         }
 293         print "</TR></TABLE>\n";
 294       } # if
 295     } # if
 296   } # while
 297 } # chordpro2html
 298
 299 ## Main
 300 print header;
 301
 302 unless ($infile) {
 303         error "No chordpro parameter";
 304 } # unless
 305
 306 open my $file, '<', $infile
 307   or error "Unable to open file $infile - $!";
 308
 309 {
 310   local $/;
 311   $chopro = <$file>;
 312 }
 313
 314 chopro2html ($chopro, $infile);
 315
 316 print end_html();
 317
 318 exit;
 319
 320