Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Home Page Manager

by Ovid (Cardinal)
on Sep 17, 2000 at 22:17 UTC ( #32880=sourcecode: print w/ replies, xml ) Need Help??

Category: Web Stuff
Author/Contact Info ovid@easystreet.com
Description: So, you want to read CNN.com in the morning before work, perlmonks.org at night when you get home, and every Wednesday at 5:00 PM your favorite Web site issues an update. Rather than scramble for your bookmarks or search through links on your links bar, here's a utility which stores homepages based upon time. Set this script as your home page and enjoy! If you don't have a homepage set up for a particular day/time, it sends you to the default home page that you have specified.

It's definitely beta quality, so any suggestions would be appreciated.

#!/usr/bin/perl -Tw
#
# Home page manager -- hpage.cgi version 0.5 September 17, 2000
#
# This program is copyright 2000 by Curtis A. Poe (ovid@easystreet.com
+ or poec@yahoo.com).
# This code may be copied, reused, or distributed under the same terms
+ as Perl itself so
# long as this copyright notice is included.
#
# There are no warranties, expressed or implied for this code and you 
+use it at your 
# sole risk and discretion.
# 
# This code should be considered beta quality at best.  I have tried t
+o only use modules
# included in the standard distribution, so this should run "as is".  
+A flat file is used
# as the database to ensure cross-platform compatibility.
#
# To use, do the following:
# 1.  Add program to a directory that allows CGI scripts and set permi
+ssions as appropriate.
# 2.  Create an empty file with the same path and name as the $url_dat
+a variable.
# 3.  Set permissions on this file as read/write for your CGI script.
# 4.  Set the CGI script as the home page for your browser.
#
# The first time this script runs, if the steps above were followed, i
+t will automatically
# take you to an update page where you may add or delete URLs as appro
+priate.  To access that
# page in the future, use http://yourserver/path/to/script/hpage.cgi?p
+rocess=update
#
# Some things to do in the future:
#
# 1.  Add support for Text::CSV (people should really use this anyway)
# 2.  Add a description field to display instead of the URL (long urls
+ make the table ugly)
# 3.  Allow people to customize the colors, fonts, etc. of the update 
+table (low on the list)
# 4.  Have the very first page show up in a frame with a thin top fram
+e for "update urls" or 
#     "make top frame go away"
# 5.  Cookie support for modest security.  If cookie disappears, a log
+in screen appears.  This
#     is also low priority -- who cares if someone messes with your ho
+me page?
# 6.  Add "all day" and "every day" choices for home pages
# 7.  The user interface is pitiful and needs to be improved

use strict;

use CGI;
use URI::Escape;

my ($day, $time) = (split /\s|:/, localtime)[0,3];
my @weekday   = qw(Sun Mon Tue Wed Thu Fri Sat);
my $day_regex = join '|', @weekday;
my $separator = "::"; # be careful not to pick something with a specia
+l meaning in a regex
                      
my $query = new CGI;
my (%url, $now, $default_url);
my $url_data = 'urldata.dat'; # set this to an appropriate path and na
+me

read_data();

# we are testing for two modes here.  If it's "update", go to the upda
+te page.
# if it's "add", we're at the update page and are adding a new URL.

if (defined $query->param("process")) {
    if ($query->param("process") eq "update") {
        print_form();
    } elsif ($query->param("process") eq "add") {
        add_data();
        print_form();
    }
    exit();
} else {
    go_homepage();
}

sub read_data {
    # sample %url hash:
    # %url = (Sun => 
    #                 { 7  => "http://www.perlmonks.com/",
    #                   17 => "http://www.slashdot.com/" },
    #         Wed =>
    #                 { 9  => "http://www.yahoo.com/",
    #                   15 => "http://www.superbad.com/",
    #                   23 => "http://www.easystreet.com/~ovid/" },
    #         Fri => 
    #                 { 16 => "http://www.slashdot.com/" },
    #        );
    # In the above example, for any day that is not listed gets the $d
+efault_url.
    # If the day is listed, it will get the default URL for any time b
+efore the 
    # first time, and after that, will get the URL for the timeframe s
+pecified
    # until the next time specified, or until the end of day.
    # For example, Wednesday, at 1:00 PM, the browser will be send to 
+Yahoo!

    if (!(-e "$url_data")) {
        first_run(0);
    } else {
        open DATA, "< $url_data" or die "Could not open $url_data: $!\
+n";

        $default_url = <DATA>;
        chomp $default_url;

        # If default url is empty, close the file, initialize it, and 
+reopen it.
        if ($default_url =~ /^\s*$/) {
            close DATA or die "Could not close $url_data: $!\n";
            first_run(1);
            open DATA, "< $url_data" or die "Could not open $url_data:
+ $!\n";
        }

        while (<DATA>) {
            my ($day, $hour, $url) = split(/$separator/, $_, 3);
            if (defined $url) {
                chomp $url;
                $url{$day}{$hour} = $url;
            }
        }
        close DATA or die "Could not close $url_data: $!\n";
    }
}

sub add_data {
    # This sub takes all data from the %url hash and writes it to $url
+_data
    # The first line of $url_data is the $default_url

    my ($daykey, $hourkey);

    get_form_data();

    open DATA, "> $url_data" or die "Can't open $url_data for writing:
+ $!\n";
    my $safe_default = uri_escape($default_url); 
    print DATA $safe_default . "\n";

    foreach $daykey (keys %url) {
        foreach $hourkey (keys %{$url{$daykey}}) {
            if (defined $url{$daykey}{$hourkey}) {
                my $unsafe_url = $url{$daykey}{$hourkey};
                my $safe_url   = uri_escape($unsafe_url) ;
                print DATA $daykey . $separator . $hourkey . $separato
+r. $safe_url . "\n";
            }
        }
    }
    print DATA "\n";
    close DATA or die "Could not close $url_data: $!\n";

    go_homepage() if defined $query->param("done");
}

# The following sub sends the browser to the appropriate URL, or the d
+efault url
# if no URL is found in the hash for the day/hour listed.

sub go_homepage {
    # The following line greps for values <= $now, sorts them, and tak
+es the last value.
    # Thanks to [Russ] for this one

    $now = (sort grep {$_ <= $time} keys %{$url{$day}})[-1];

    if (defined $now && exists $url{$day}{$now}) {
        print $query->redirect($url{$day}{$now});
    } else {
        print $query->redirect($default_url);
    }
    exit();
}

# If the data file isn't found, the script assumes this to be the firs
+t run,
# writes the default url to the data file and then sets process to upd
+ate
# to put the user at the update screen.  (Default URL is determined by
+ the datafile
# if it exists.  Therefore, perlmonks is only the default URL on a fir
+st run.

sub first_run {
    my $file_exists = shift;

    if (! $file_exists) {
        print $query->header;
        print $query->start_html;
        print "<H3>Please create a file with the path and name of '$ur
+l_data'.</H3><P>";
        print 'Be aware that your server may require that you set appr
+opriate<BR>';
        print 'read/write permissions for this file prior to your bein
+g able<BR>';
        print 'to use it for this program.';
        print $query->end_html;
        exit();
    } else {
        $default_url = "http://www.perlmonks.org/";
        open  DATA, ">$url_data"       or die "Could not open $url_dat
+a for writing: $!\n";
        print DATA $default_url . "\n" or die "Could not print to $url
+_data: $!\n";
        close DATA                     or die "Could not close $url_da
+ta: $!\n";
        $query->param("process", "update");
    }
}

# This reads the data submitted by the form and writes it to %url. 

sub get_form_data {
    $query->delete("process"); 

    my @keys = $query->param;
    $default_url = $query->param("default_url") if defined $query->par
+am("default_url");
    foreach my $key (@keys) {
        my $value = $query->param($key);

        # This checkbox is for deleting the URL
        if ($key =~ /^CHK,($day_regex),(2[0-3]|1?[0-9])$/o) {
            my ($day, $hour) = ($1, $2);

            delete $url{$day}{$hour} if exists $url{$day}{$hour};
        }

        # The following is for adding a URL.
        if ($key eq "new_url" && $query->param("new_url") !~ /^\s*$/) 
+{
            $query->param("day")  =~ /^($day_regex$)/o    or die "Bad 
+data in day\n";
            my $day               = $1;
            $query->param("time") =~ /^(2[0-3]|1?[0-9])$/ or die "Bad 
+data in time\n";
            my $hour              = $1;
            my $url               = $query->param($key);

            $url =~ s/\s*$//; # get rid of spaces at the end of new UR
+L
            $url{$day}{$hour} = $url;
        }
    }
}

# This creates the update Web page in the browser

sub print_form {
    my ($this_day, $i, $url_counter, @time_display);

    for (0..23) {
        if ($_ == 0) {
            $time_display[$_] = 'Midnight';
        } elsif ($_ == 12) {
            $time_display[$_] = 'Noon';
        } elsif ($_ > 12) {
            my $hour          = $_ - 12;
            $time_display[$_] = "$hour:00 PM";
        } else {
            $time_display[$_] = "$_:00 AM";
        }
    }
    print $query->header(-expires=>'now');
    print $query->start_html(-title=>'hpage.cgi Update Form', 
                             -author=>'ovid@easystreet.com', 
                             -BGCOLOR=>'#6600CC');

    print << "[END]";
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0" BGCOLOR="#000000" WI
+DTH="600">
  <TR>
    <TD>
      <FORM ACTION="hpage.cgi" METHOD="POST">
      <INPUT type=hidden NAME="process" VALUE="add">
      <TABLE CELLPADDING="4" CELLSPACING="1" BORDER="0" WIDTH="100%">
        <TR BGCOLOR="#000000">
          <TD COLSPAN="4">
            <FONT COLOR="#FFFFFF"><STRONG>Defaults</STRONG></FONT>
          </TD>
        </TR>           
        <TR BGCOLOR="#99CCCC">
          <TD COLSPAN="4">
            <INPUT TYPE="TEXT" MAXLENGTH="100" SIZE="40" NAME="default
+_url" VALUE="${default_url}">&nbsp;&nbsp;Default URL
          </TD>
        </TR>
        <TR BGCOLOR="#000000">
          <TD COLSPAN="4">
            <FONT COLOR="#FFFFFF"><STRONG>Home Page Data</STRONG></FON
+T>
          </TD>
        </TR>
        <TR BGCOLOR="#99CCCC">
          <TH>Delete</TH><TH>Day</TH><TH>Time</TH><TH>URL</TH>
        </TR>
        <TR BGCOLOR="#99CCCC">
[END]

    foreach $this_day (@weekday) {
        if (defined $url{$this_day}) {
            foreach (sort {$a <=> $b} keys %{$url{$this_day}}) {
                print "<TR BGCOLOR=\"#99CCCC\">\n";
                print "<TD><INPUT TYPE=CHECKBOX NAME=\"CHK,${this_day}
+,${_}\"></TD>\n";
                print "<TD>$this_day</TD>\n";
                print "<TD>$time_display[$_]</TD>\n";
                print "<TD><A HREF=\"$url{$this_day}{$_}\" TARGET=\"_b
+lank\">$url{$this_day}{$_}</A></TD>\n";
                print "</TR>\n";
                $url_counter++;
            }
        }
    }
    unless ($url_counter) {
        print "<TR BGCOLOR=\"#99CCCC\"><TD COLSPAN=\"4\"><B>No homepag
+es have been specified.</B></TD></TR>\n";
    }
    print << "[END]";
        <TR BGCOLOR="#000000">
          <TD COLSPAN="4">
            <FONT COLOR="#FFFFFF"><STRONG>Add a Home Page</STRONG></FO
+NT>
          </TD>
        </TR>
      </TABLE>
      <TABLE CELLPADDING="4" CELLSPACING="1" BORDER="0" WIDTH="100%">
        <TR BGCOLOR="#99CCCC">
          <TH>Day</TH><TH>Time</TH><TH>URL</TH>
        </TR>
        <TR BGCOLOR="#99CCCC">
          <TD>
            <SELECT NAME="day">
[END]
    foreach (@weekday) {
        print "<OPTION>${_}\n";
    }
    print << "[END]";
            </SELECT>
          </TD>
          <TD>
            <SELECT NAME="time">
[END]
    for (0..23) {
        print "<OPTION VALUE=$_>$time_display[$_]</OPTION>\n";
    }
    print << "[END]";
            </SELECT>
          </TD>
          <TD>
            <INPUT TYPE="TEXT" MAXLENGTH="100" SIZE="35" NAME="new_url
+">
          </TD>
        </TR>
        <TR BGCOLOR="#000000">
          <TD COLSPAN="3">
            <FONT COLOR="#FFFFFF"><STRONG>Are you done yet?</STRONG></
+FONT>
          </TD>
        </TR>
        <TR BGCOLOR="#99CCCC">
          <TD COLSPAN="3">
            <INPUT TYPE="CHECKBOX" NAME="done"> Click here when finish
+ed. (This will send you to your homepage)
          </TD>
    </TR>
        <TR>
          <TD COLSPAN="3">
            <FONT COLOR="#FFFFFF"><STRONG>Buttons (duh!)</STRONG></FON
+T>
          </TD>
        </TR>
        <TR BGCOLOR="#99CCCC">
          <TD COLSPAN="2">
            <INPUT TYPE="submit" VALUE="Stumbit">
          </TD>
          <TD ALIGN=RIGHT>
            <INPUT TYPE="reset" VALUE="Clear Form">
          </TD>
        </TR>
      </TABLE>
    </TD>
  </TR>
</TABLE>
</BODY>
</HTML>
[END]
}

Comment on Home Page Manager
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://32880]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (8)
As of 2014-09-02 06:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (20 votes), past polls