http://www.perlmonks.org?node_id=474945
Category: CGI Programming
Author/Contact Info corey@uptimemusic.com
Description: This is a small CGI app designed to retrieve a band's gig dates from a formatted text file, sort them by date, and display either Upcoming Shows or Previous Shows (based on the current date). Much more extensible version of gigdates.pl Uses CGI::Application.
#### GigDates.pm ###

package GigDate;
  
use base 'CGI::Application';
use strict;
use warnings;

    
my $infile = "gigdates.txt";
my %gigdates;
my @unsorteddates;
my @sorteddatesmonth;
my @sorteddates;
my %fonts;
my $count = 0;

open(INFILEHANDLE, $infile) or die "Couldn't open $infile for reading:
+  $! \n";

# read input file,  skipping blank lines, dropping date=>place pairs i
+n a hash and dates in an array for sorting

while(<INFILEHANDLE>){
        next if /^(\s)*$/;
        my $date = $_;
        my $place = $_;
    my $font = $_;
    $font =~ s/^.+.\|//;
        $date =~ s/\/*\@.+//;
        $place =~ s/^.+.\@ //;
    $place =~ s/\|.+//;
        chomp($date);
        chomp($place);
    chomp($font);
        $unsorteddates[$count] = $date;
        $gigdates{$date} = $place;
    $fonts{$date} = $font;
        $count++;
}
# Transform dates Schwartzianly
@sorteddatesmonth =
    map { $_->[0] }
    sort {
    $a->[2] <=> $b->[2]
    }
    map { [ $_, split /\// ] } 
    @unsorteddates;
 @sorteddates =  map { $_->[0] }
 sort { $a->[1] <=> $b->[1] }
 map { [ $_, split /\// ] }  @sorteddatesmonth;

# Get todays date
my ($day, $month, $today, $thismonth, $thisday, $showtoday);
my @upcomingdates;
my @pastdates;

($thisday, $thismonth) = (localtime)[3,4];
$thismonth++;

# Based on the current date,  index the upcoming shows and past show d
+ates
foreach(@sorteddates){
            my ($month, $day) = split(/\//, $_);
          if (($month == $thismonth) && ($day == $thisday)) {
                    $showtoday = $_;
            }
            elsif($month >= $thismonth && $day >= $thisday) {
                    push(@upcomingdates, $_);
            }
            elsif($month > $thismonth && $day <= $thisday) {
                    push(@upcomingdates, $_);
            }
            elsif($month <= $thismonth && $day < $thisday) {
                    push(@pastdates, $_);
                }
            elsif($month < $thismonth && $day >= $thisday) {
                    push(@pastdates, $_);
            }
                                                                }
                                                
    unshift(@upcomingdates, $showtoday);
     close(INFILEHANDLE);


sub setup {
            my $self = shift;
            $self->start_mode('mode1');
            $self->mode_param('rm');
            $self->run_modes(
                         'mode1' => 'upcomingshows',
                         'mode2' => 'previousshows',
                          );
         }
     
sub upcomingshows {
my $upcomingshow;
my $output;


foreach $upcomingshow (@upcomingdates) {
            if (exists $gigdates{$upcomingshow}) {
                    $output .= "$upcomingshow @ $gigdates{$upcomingsho
+w} <br><br> \n";
            }
    $output = "<div align=\"center\"><font size=5 face=\"$fonts{$upcom
+ingshow}\" color=\"3333FF\">".$output."</font></div>";
    }
    return $output;
}                                            

sub previousshows {
my $previousshow;
my $output;

foreach $previousshow (@pastdates) {
            if (exists $gigdates{$previousshow}) {
                            $output .= "$previousshow @ $gigdates{$pre
+viousshow} <br><br> \n";
                    }
        $output = "<div align=\"center\"><font size=5 face=\"$fonts{$p
+reviousshow}\" color=\"3333FF\">".$output."</font></div>";
    }
        return $output;        
}
    
1;
#### gigsapp.pl ####
#!/usr/bin/perl -w

use strict;

use GigDate;
my $webapp = GigDate->new();
$webapp->run();
#print STDERR $webapp->dump();  #debug
#### gigdatesadmin.pl ####
# This one goes in a subdir "admin". Uses a form to add/delete lines from the formatted text file.
#!/usr/bin/perl

use strict;
use warnings;
use CGI;

$|++;

my $query = new CGI;

print $query->header();

my $month = $query->param("month");
my $day = $query->param("day");
my $place = $query->param("place");
my $time = $query->param("time");
my $extra = $query->param("extra");
my $type = $query->param("type");
my $font = $query->param("font");

my $date = "$month\/$day" if ($month && $day);


if($type == "add"){

my $outfile = "../gigdates.txt";

open (OUTFILEHANDLE, ">> $outfile") or die print "Couldn't open $outfi
+le: $! \n";

my $newshow = "$date @ $place - $time - $extra | $font\n" if ($month &
+& $day && $place);

print OUTFILEHANDLE $newshow if ($newshow);

close(OUTFILEHANDLE);

}

if(($type == "remove") && $date && !($place)){
    # May need this in the future:
    #use Tie::File;
    #my  @aFileLines;
        #my  $sFileIn    = "../gigdates.txt";
    #tie (@aFileLines, 'Tie::File', $sFileIn) or die "$!";
    #@aFileLines = grep{$_!~/Q$date/g;}@aFileLines;
    #untie @aFileLines   or die "$!";
    my $infile = "../gigdates.txt";
    my $outfile = "../gigdates.txt";
    open(IN,$infile) || die $!;
    my @contents = grep { !/$date/ } <IN>;
    close(IN);
    open(OUT,">".$outfile) || die $!;
    print OUT @contents;
    close(OUT);
}


print <<END_HTML;

<html>
<head>
    <title>Gig Dates Admin</title>
    <META http-equiv="Content-Script-Type" content="text/javascript">

    </head>

    <body>


    <table align="left" border="0" cellspacing="2" cellpadding="2" wid
+th="40%" height="40%">


    <tr>
        <th>Previous Shows:</th>   <td><iframe src="../gigsapp.pl?rm=m
+ode2" name="previous"></iframe></td>
            
        </tr>
        </table>
        <table align="top" border="0" cellspacing="2" cellpadding="2" 
+width="40%" height="40%">


        <tr>
            <th>Upcoming Shows:</th>   <td><iframe src="../gigsapp.pl?
+rm=mode1" name="upcoming"></iframe></td>
                 
            </tr>
            </table>
            <br><br>

            <form name="add" action="gigdatesadmin.pl" method="POST">
            <input type="hidden" name="type" value="add">
            <div align="left">
            <font face="Verdana" color="CC3333" size="3"><b>ADD A SHOW
+: </b></font> <br><br>

            Date:    Month:<input type="text" name="month" maxlength="
+2" size="2" value=""/> / Day:<input type="text" name="day" maxlength=
+"2" size="2" value="" /><br>
            Place: <input type="text" name="place" maxlength="256" val
+ue=""/><br>
            Time:  <input type="text" name="time" maxlength="20" value
+=""/><br>
            Extra Info: <input type="text" name="extra" maxlength="256
+" value=""/><br>
            Select a font: <select name="font">
                <option value="Impact">Impact</option>
                <option value="Verdana">Verdana</option>
                <option value="Arial">Arial</option>
                <option value="Tahoma">Tahoma</option>
                </select>
            <INPUT TYPE="BUTTON" VALUE="Add Show" onClick="document.ad
+d.submit()">
            </div>
            </form>

            <form name="remove" action="gigdatesadmin.pl" method="POST
+">
            <input type="hidden" name="type" value="remove">
            <div align="top">
            <br><br><br>
            <font face="Verdana" color="CC3333" size="3"><b>REMOVE A S
+HOW: </b></font> <br><br>

            Date:    Month:<input type="text" name="month" maxlength="
+2" size="2" value=""/> / Day:<input type="text" name="day" maxlength=
+"2" size="2" value=""/><br>
            <INPUT TYPE="BUTTON" VALUE="Remove Show" onClick="document
+.remove.submit()">
            </div>


            </form>

            </body>
            </html>

END_HTML


Format of each line of the text file (gigdates.txt) is like so:

month/day @ Place - Time - ExtraInfo | font

example: 5/5 @ Las Palmitas - 9pm - Cinco de Mayo! | Impact