defaria.com/cgi/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: 32pt;
 147 }
 148 h2 {
 149   text-align: center;
 150   font-family: Arial, Helvetica;
 151   font-size: 24pt;
 152 }
 153 .lyrics, .lyrics_chorus {
 154   font-size: 18pt;
 155 }
 156 .lyrics_tab, .lyrics_chorus_tab {
 157   font-family: "Courier New", Courier;
 158   font-size: 18pt;
 159 }
 160 .lyrics_chorus, .lyrics_chorus_tab, .chords_chorus, .chords_chorus_tab {
 161   font-weight: bold;
 162 }
 163 .chords, .chords_chorus, .chords_tab, .chords_chorus_tab {
 164   font-size: 18pt;
 165   color: blue;
 166   padding-right:
 167   4pt;
 168 }
 169 .comment, .comment_italic {
 170   color: #999;
 171   font-size: 18pt;
 172 }
 173 .comment_box {
 174   background-color: #ffbbaa;
 175   text-align: center;
 176 }
 177 .comment_italic {
 178   font-style: italic;
 179 }
 180 .comment_box {
 181   border: solid;
 182 }
 183 </style>
 184 </head>
 185 <body>
 186 END
 187
 188       $title = musicFileExists $song;
 189
 190       if ($title) {
 191         updateMusicpath $chopro, $song;
 192       } # if
 193
 194       print << "END";
 195 <table border="0" width="100%">
 196   <tbody>
 197     <tr>
 198       <td align="left"><a href="/songbook"><img src="/Icons/Home.png" alt="Home"></a></td>
 199 END
 200
 201       if ($title) {
 202         print <<"END";
 203 <td align="right">
 204 <audio controls autoplay>
 205  <source src="http://defaria.com/songbook/Media/$title.mp3" type='audio/mp3'>
 206  <p>Your user agent does not support the HTML5 Audio element.</p>
 207 </audio>
 208 </td>
 209 END
 210       } # if
 211 print <<"END";
 212     </tr>
 213   </tbody>
 214 </table>
 215 END
 216   my $mode = 0; # mode defines which class to use
 217
 218   #mode =           0           1              2             3
 219   #       normal      chorus         normal+tab    chorus+tab
 220   my @lClasses = ('lyrics', 'lyrics_chorus', 'lyrics_tab', 'lyrics_chorus_tab'  );
 221   my @cClasses = ('chords', 'chords_chorus', 'chords_tab', 'chords_chorus_tab'  );
 222
 223   while($chopro ne '') {
 224     $chopro =~ s/(.*)\n?//; # extract and remove first line
 225     $_ = $1;
 226     chomp;
 227
 228     if(/^#(.*)/) {                                # a line starting with # is a comment
 229       print "<!--$1-->\n";                        # insert as HTML comment
 230     } elsif(/{(.*)}/) {                           # this is a command
 231       $_ = $1;
 232       if(/^title:/i || /^t:/i) {                  # title
 233         print "<H1>$'</H1>\n";
 234       } elsif(/^subtitle:/i || /^st:/i) {         # subtitle
 235         print "<H2>$'</H2>\n";
 236       } elsif(/^start_of_chorus/i || /^soc/i) {   # start_of_chorus
 237         $mode |= 1;
 238       } elsif(/^end_of_chorus/i || /^eoc/i) {     # end_of_chorus
 239         $mode &= ~1;
 240       } elsif(/^comment:/i || /^c:/i) {           # comment
 241         print "<span class=\"comment\">($')</span>\n";
 242       } elsif(/^comment_italic:/i || /^ci:/i) {   # comment_italic
 243         print "<span class=\"comment_italic\">($')</span>\n";
 244       } elsif(/^comment_box:/i || /^cb:/i) {      # comment_box
 245         print "<P class=\"comment_box\">$'</P>\n";
 246       } elsif(/^start_of_tab/i || /^sot/i) {      # start_of_tab
 247         $mode |= 2;
 248       } elsif(/^end_of_tab/i || /^eot/i) {        # end_of_tab
 249         $mode &= ~2;
 250       } else {
 251         print "<!--Unsupported command: $_-->\n";
 252       }
 253     } else { # this is a line with chords and lyrics
 254       my(@chords,@lyrics);
 255       @chords=("");
 256       @lyrics=();
 257       s/\s/\&nbsp;/g;         # replace spaces with hard spaces
 258       while(s/(.*?)\[(.*?)\]//) {
 259         push(@lyrics,$1);
 260         push(@chords,$2 eq '\'|' ? '|' : $2);
 261       }
 262       push(@lyrics,$_);       # rest of line (after last chord) into @lyrics
 263
 264       if($lyrics[0] eq "") {  # line began with a chord
 265         shift(@chords);       # remove first item
 266         shift(@lyrics);       # (they are both empty)
 267       }
 268
 269       if(@lyrics==0) {  # empty line?
 270         print "<BR>\n";
 271       } elsif(@lyrics==1 && $chords[0] eq "") { # line without chords
 272         print "<DIV class=\"$lClasses[$mode]\">$lyrics[0]</DIV>\n";
 273       } else {
 274         print "<TABLE cellpadding=0 cellspacing=0>";
 275         print "<TR>\n";
 276         my($i);
 277         for($i = 0; $i < @chords; $i++) {
 278           print "<TD class=\"$cClasses[$mode]\">$chords[$i]</TD>";
 279         }
 280         print "</TR>\n<TR>\n";
 281         for($i = 0; $i < @lyrics; $i++) {
 282           print "<TD class=\"$lClasses[$mode]\">$lyrics[$i]</TD>";
 283         }
 284         print "</TR></TABLE>\n";
 285       } # if
 286     } # if
 287   } # while
 288 } # chordpro2html
 289
 290 ## Main
 291 print header;
 292
 293 unless ($infile) {
 294         error "No chordpro parameter";
 295 } # unless
 296
 297 open my $file, '<', $infile
 298   or error "Unable to open file $infile - $!";
 299
 300 {
 301   local $/;
 302   $chopro = <$file>;
 303 }
 304
 305 chopro2html ($chopro, $infile);
 306
 307 print end_html();
 308
 309 exit;
 310
 311