<?xml version="1.0" encoding="windows-1252"?>
<node id="32880" title="Home Page Manager" created="2000-09-17 18:17:21" updated="2005-08-15 16:01:50">
<type id="1748">
sourcecode</type>
<author id="17000">
Ovid</author>
<data>
<field name="doctext">
&lt;CODE&gt;
#!/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 to 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 permissions as appropriate.
# 2.  Create an empty file with the same path and name as the $url_data 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, it will automatically
# take you to an update page where you may add or delete URLs as appropriate.  To access that
# page in the future, use http://yourserver/path/to/script/hpage.cgi?process=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 frame for "update urls" or 
#     "make top frame go away"
# 5.  Cookie support for modest security.  If cookie disappears, a login screen appears.  This
#     is also low priority -- who cares if someone messes with your home 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 special 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 name

read_data();

# we are testing for two modes here.  If it's "update", go to the update page.
# if it's "add", we're at the update page and are adding a new URL.

if (defined $query-&gt;param("process")) {
    if ($query-&gt;param("process") eq "update") {
        print_form();
    } elsif ($query-&gt;param("process") eq "add") {
        add_data();
        print_form();
    }
    exit();
} else {
    go_homepage();
}

sub read_data {
    # sample %url hash:
    # %url = (Sun =&gt; 
    #                 { 7  =&gt; "http://www.perlmonks.com/",
    #                   17 =&gt; "http://www.slashdot.com/" },
    #         Wed =&gt;
    #                 { 9  =&gt; "http://www.yahoo.com/",
    #                   15 =&gt; "http://www.superbad.com/",
    #                   23 =&gt; "http://www.easystreet.com/~ovid/" },
    #         Fri =&gt; 
    #                 { 16 =&gt; "http://www.slashdot.com/" },
    #        );
    # In the above example, for any day that is not listed gets the $default_url.
    # If the day is listed, it will get the default URL for any time before the 
    # first time, and after that, will get the URL for the timeframe specified
    # 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, "&lt; $url_data" or die "Could not open $url_data: $!\n";

        $default_url = &lt;DATA&gt;;
        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, "&lt; $url_data" or die "Could not open $url_data: $!\n";
        }

        while (&lt;DATA&gt;) {
            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, "&gt; $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 . $separator. $safe_url . "\n";
            }
        }
    }
    print DATA "\n";
    close DATA or die "Could not close $url_data: $!\n";

    go_homepage() if defined $query-&gt;param("done");
}

# The following sub sends the browser to the appropriate URL, or the default url
# if no URL is found in the hash for the day/hour listed.

sub go_homepage {
    # The following line greps for values &lt;= $now, sorts them, and takes the last value.
    # Thanks to [Russ] for this one

    $now = (sort grep {$_ &lt;= $time} keys %{$url{$day}})[-1];

    if (defined $now &amp;&amp; exists $url{$day}{$now}) {
	    print $query-&gt;redirect($url{$day}{$now});
    } else {
	    print $query-&gt;redirect($default_url);
    }
    exit();
}

# If the data file isn't found, the script assumes this to be the first run,
# writes the default url to the data file and then sets process to update
# 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 first run.

sub first_run {
    my $file_exists = shift;

    if (! $file_exists) {
        print $query-&gt;header;
        print $query-&gt;start_html;
        print "&lt;H3&gt;Please create a file with the path and name of '$url_data'.&lt;/H3&gt;&lt;P&gt;";
        print 'Be aware that your server may require that you set appropriate&lt;BR&gt;';
        print 'read/write permissions for this file prior to your being able&lt;BR&gt;';
        print 'to use it for this program.';
        print $query-&gt;end_html;
        exit();
    } else {
        $default_url = "http://www.perlmonks.org/";
        open  DATA, "&gt;$url_data"       or die "Could not open $url_data 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_data: $!\n";
        $query-&gt;param("process", "update");
    }
}

# This reads the data submitted by the form and writes it to %url. 

sub get_form_data {
    $query-&gt;delete("process"); 

    my @keys = $query-&gt;param;
    $default_url = $query-&gt;param("default_url") if defined $query-&gt;param("default_url");
    foreach my $key (@keys) {
        my $value = $query-&gt;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" &amp;&amp; $query-&gt;param("new_url") !~ /^\s*$/) {
            $query-&gt;param("day")  =~ /^($day_regex$)/o    or die "Bad data in day\n";
            my $day               = $1;
            $query-&gt;param("time") =~ /^(2[0-3]|1?[0-9])$/ or die "Bad data in time\n";
            my $hour              = $1;
            my $url               = $query-&gt;param($key);

            $url =~ s/\s*$//; # get rid of spaces at the end of new URL
            $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 ($_ &gt; 12) {
            my $hour          = $_ - 12;
            $time_display[$_] = "$hour:00 PM";
        } else {
            $time_display[$_] = "$_:00 AM";
        }
    }
    print $query-&gt;header(-expires=&gt;'now');
    print $query-&gt;start_html(-title=&gt;'hpage.cgi Update Form', 
                             -author=&gt;'ovid@easystreet.com', 
                             -BGCOLOR=&gt;'#6600CC');

    print &lt;&lt; "[END]";
&lt;TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0" BGCOLOR="#000000" WIDTH="600"&gt;
  &lt;TR&gt;
    &lt;TD&gt;
      &lt;FORM ACTION="hpage.cgi" METHOD="POST"&gt;
	  &lt;INPUT type=hidden NAME="process" VALUE="add"&gt;
      &lt;TABLE CELLPADDING="4" CELLSPACING="1" BORDER="0" WIDTH="100%"&gt;
        &lt;TR BGCOLOR="#000000"&gt;
          &lt;TD COLSPAN="4"&gt;
            &lt;FONT COLOR="#FFFFFF"&gt;&lt;STRONG&gt;Defaults&lt;/STRONG&gt;&lt;/FONT&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;           
        &lt;TR BGCOLOR="#99CCCC"&gt;
          &lt;TD COLSPAN="4"&gt;
            &lt;INPUT TYPE="TEXT" MAXLENGTH="100" SIZE="40" NAME="default_url" VALUE="${default_url}"&gt;&amp;nbsp;&amp;nbsp;Default URL
          &lt;/TD&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#000000"&gt;
          &lt;TD COLSPAN="4"&gt;
            &lt;FONT COLOR="#FFFFFF"&gt;&lt;STRONG&gt;Home Page Data&lt;/STRONG&gt;&lt;/FONT&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#99CCCC"&gt;
          &lt;TH&gt;Delete&lt;/TH&gt;&lt;TH&gt;Day&lt;/TH&gt;&lt;TH&gt;Time&lt;/TH&gt;&lt;TH&gt;URL&lt;/TH&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#99CCCC"&gt;
[END]

    foreach $this_day (@weekday) {
        if (defined $url{$this_day}) {
    		foreach (sort {$a &lt;=&gt; $b} keys %{$url{$this_day}}) {
	    	    print "&lt;TR BGCOLOR=\"#99CCCC\"&gt;\n";
		        print "&lt;TD&gt;&lt;INPUT TYPE=CHECKBOX NAME=\"CHK,${this_day},${_}\"&gt;&lt;/TD&gt;\n";
    			print "&lt;TD&gt;$this_day&lt;/TD&gt;\n";
	    		print "&lt;TD&gt;$time_display[$_]&lt;/TD&gt;\n";
		    	print "&lt;TD&gt;&lt;A HREF=\"$url{$this_day}{$_}\" TARGET=\"_blank\"&gt;$url{$this_day}{$_}&lt;/A&gt;&lt;/TD&gt;\n";
			    print "&lt;/TR&gt;\n";
	    		$url_counter++;
		    }
    	}
    }
	unless ($url_counter) {
	    print "&lt;TR BGCOLOR=\"#99CCCC\"&gt;&lt;TD COLSPAN=\"4\"&gt;&lt;B&gt;No homepages have been specified.&lt;/B&gt;&lt;/TD&gt;&lt;/TR&gt;\n";
    }
	print &lt;&lt; "[END]";
        &lt;TR BGCOLOR="#000000"&gt;
          &lt;TD COLSPAN="4"&gt;
            &lt;FONT COLOR="#FFFFFF"&gt;&lt;STRONG&gt;Add a Home Page&lt;/STRONG&gt;&lt;/FONT&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;
      &lt;/TABLE&gt;
      &lt;TABLE CELLPADDING="4" CELLSPACING="1" BORDER="0" WIDTH="100%"&gt;
        &lt;TR BGCOLOR="#99CCCC"&gt;
          &lt;TH&gt;Day&lt;/TH&gt;&lt;TH&gt;Time&lt;/TH&gt;&lt;TH&gt;URL&lt;/TH&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#99CCCC"&gt;
          &lt;TD&gt;
            &lt;SELECT NAME="day"&gt;
[END]
    foreach (@weekday) {
	    print "&lt;OPTION&gt;${_}\n";
	}
	print &lt;&lt; "[END]";
            &lt;/SELECT&gt;
          &lt;/TD&gt;
          &lt;TD&gt;
            &lt;SELECT NAME="time"&gt;
[END]
    for (0..23) {
        print "&lt;OPTION VALUE=$_&gt;$time_display[$_]&lt;/OPTION&gt;\n";
    }
	print &lt;&lt; "[END]";
            &lt;/SELECT&gt;
          &lt;/TD&gt;
          &lt;TD&gt;
            &lt;INPUT TYPE="TEXT" MAXLENGTH="100" SIZE="35" NAME="new_url"&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#000000"&gt;
          &lt;TD COLSPAN="3"&gt;
            &lt;FONT COLOR="#FFFFFF"&gt;&lt;STRONG&gt;Are you done yet?&lt;/STRONG&gt;&lt;/FONT&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#99CCCC"&gt;
          &lt;TD COLSPAN="3"&gt;
            &lt;INPUT TYPE="CHECKBOX" NAME="done"&gt; Click here when finished. (This will send you to your homepage)
          &lt;/TD&gt;
	&lt;/TR&gt;
        &lt;TR&gt;
          &lt;TD COLSPAN="3"&gt;
            &lt;FONT COLOR="#FFFFFF"&gt;&lt;STRONG&gt;Buttons (duh!)&lt;/STRONG&gt;&lt;/FONT&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;
        &lt;TR BGCOLOR="#99CCCC"&gt;
          &lt;TD COLSPAN="2"&gt;
            &lt;INPUT TYPE="submit" VALUE="Stumbit"&gt;
          &lt;/TD&gt;
          &lt;TD ALIGN=RIGHT&gt;
            &lt;INPUT TYPE="reset" VALUE="Clear Form"&gt;
          &lt;/TD&gt;
        &lt;/TR&gt;
      &lt;/TABLE&gt;
    &lt;/TD&gt;
  &lt;/TR&gt;
&lt;/TABLE&gt;
&lt;/BODY&gt;
&lt;/HTML&gt;
[END]
}
&lt;/CODE&gt;</field>
<field name="codedescription">
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.
&lt;P&gt;
It's definitely beta quality, so any suggestions would be appreciated.</field>
<field name="codecategory">
Web Stuff</field>
<field name="codeauthor">
&lt;A HREF="mailto:ovid@easystreet.com"&gt;ovid@easystreet.com&lt;/A&gt;</field>
</data>
</node>
