Someone in alt.perl wanted a CGI script to display a different picture every day. So, put the pictures at the URLs of /picture/picture_1.jpg,/picture/picture_2.jpg,/picture/picture_3.jpg, and so on, up to /picture/picture_365.jpg, and use this CGI script.
#!/usr/bin/perl printf "Location: /picture/picture_%d.jpg\n\n", (localtime)[7];

Replies are listed 'Best First'.
Re: A Picture A Day
by mortis (Pilgrim) on Dec 19, 2001 at 20:43 UTC
    Is a Location header ok without the HTTP status line? Do you need an HTTP 302 Redirect (or 303) status line before the location for a redirect? Or will most browsers handle the naked Location as a valid header?
      The browser never sees it. This is a CGI header. The server interprets it as a request to go to that URL and start over. Thus, it'll even handle if-modified-since and last-modified correctly.

      -- Randal L. Schwartz, Perl hacker

        Thanks for the clarification -- even CGI.pm's redirect() method doesn't print the status line:
        perl -MCGI -e 'print CGI->new({})->redirect("/foo/b ar.cgi");'
        gives:
        Status: 302 Moved
        location: /foo/bar.cgi
        
        
        This doesn't apply to nph CGI's, correct?

        I didn't know that. Thanks

        The browser DOES see it. The webserver will add the status by itself, or takes it from the Status header.
        This means there'll be _two_ requests, one'll hit the request, one'll hit the image. If everything's fast enough, the user will never notice.

        a251111.upc-a.chello.nl - - [19/Dec/2001:16:55:17 +0100] "GET /test/te +st.cgi HTTP/1.1" 302 286 "-" "Mozilla/5.0 (compatible; Konqueror/2.2. +2; Linux 2.4.10-ac12; X11; i686; en)" a251111.upc-a.chello.nl - - [19/Dec/2001:16:55:18 +0100] "GET /test/te +st.txt HTTP/1.1" 304 - "-" "Mozilla/5.0 (compatible; Konqueror/2.2.2; + Linux 2.4.10-ac12; X11; i686; en)"
        The 302 status is "Found", which tells the browser to re-request using the URL in the Location-header.
        The 304 is "Not modified", telling my browser to use the cached version.

        2;0 juerd@serv:~/juerd.nl/juerd.nl/test$ cat test.cgi #!/usr/bin/perl print "Location: test.txt\n\n"; 2;0 juerd@serv:~/juerd.nl/juerd.nl/test$ cat test.txt; echo Hello world
        merlyn, perhaps you meant s/browser/user/; s/CGI/HTTP/; s/server/browser/?

        2;0 juerd@ouranos:~$ perl -e'undef christmas' Segmentation fault 2;139 juerd@ouranos:~$

Re: A Picture A Day
by mstone (Deacon) on Dec 20, 2001 at 04:33 UTC

    This is anything but a one-liner, but it's what I use to rotate my desktop image. It walks a file tree looking for subdirs and image files, keeping them separate so the chance of descent remains stable reagrdless of how many items there are in a given directory. It also lets you put weights on files, and mark files/directories you want to ignore.

    This version happens to link the selected file from a known location, but it would be easy to replace that with code that redirects browsers the file's URL.

    #!/usr/local/bin/perl -w ## set up some globals $BASE = '/base/of-the/image/path'; ## base image directory $LINK = "$BASE/desktop.jpg"; ## the target image $GO_DOWN = 0.70; ## dig deeper 70% of the time $TRY_LIMIT = 1000; ## stop after 1000 tries, max $current = "$BASE"; ## set up a path heirarchy @P = ($current); ## set up a loop counter $N = 0; while (($N++ < $TRY_LIMIT) && (-d $current)) { ## read the directory opendir (DIR, $current) or die qq(can't read "$current": $!); @D = grep { (!/^\./) && ## exclude hidden files (!/^#/) ## exclude user-selected files } readdir DIR; closedir DIR; ## get a list of subirs $d = []; @$d = grep { -d "$current/$_" } @D; ## get a list of '*.jpg' files $j = []; @$j = grep { /.jpg$/i } @D; ## assemble a list of weights.. # # the basic idea is to give some items a higher chance # of being chosen than others. if a filename begins # with a number N, the program's decision table will # contain N copies of that filename. # # we start by building a table with N-1 entries for # each item that does start with a number, then finish # off by adding the whole file list to the table. # @w = (); for $f (@$d) { if ($f =~ /^(\d+)/) { push @w, ($f) x ($1 - 1); } } push @$d, @w; ## decide whether to choose a file from this directory, ## or to pick a random directory and drill down again. # # note that we may end up choosing an empty list.. # therefore we check the list we choose to make sure # it does contain something, and if it doesn't, we # deal with it. # # the first stage of dealing with it is to fall back # to the other option.. if we chose to drill deeper and # in a directory with no subdirs, we fall back to # selecting a random image. if we chose to select an # image in a directory that only contains subdirs, we # fall back to drilling deeper. # # the second stage of dealing with it.. which occurs # if we hit an empty directory.. is to back out one # level and try again. # # in the pathological case, where you run this loop # on the base of a file tree that contains no .jpg # files at all, the loop counter will force termination # after $TRY_LIMIT tries. # ($l, $r) = (rand() < $GO_DOWN) ? ($d, $j) : ($j, $d); $list = (@$l) ? $l : $r; if (@$list) { push @P, $list->[ rand (@$list) ]; } else { pop @P; } $current = join ('/', @P); } unlink $LINK; link $current, $LINK if (-f $current);
Re: A Picture A Day
by belg4mit (Prior) on Dec 19, 2001 at 21:16 UTC
    Of course there's always the tried and true by the long absent abigail.

    --
    perl -p -e "s/(?:\w);([st])/'\$1/mg"

Re (tilly) 1: A Picture A Day
by tilly (Archbishop) on Jan 02, 2002 at 10:56 UTC
    I hope the recipient of your answer figures out the bug before Dec 31, 2004...

    UPDATE
    Silly me. I hope they figured it out before Jan 1, 2002 or will figure it out before Jan 1, 2003 depending on whether they already rolled it out or are planning to. And I hope for myself that I remember that I shouldn't just trust gurus on minor details which I don't happen to know off-hand myself.