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