Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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] }

In reply to Home Page Manager by Ovid

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (17)
    As of 2015-07-01 16:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (9 votes), past polls