Date-Pcalc
29 results

 view release on metacpan or  search on metacpan

examples/calendar.pl  view on Meta::CPAN 

#!perl -w

###############################################################################
##                                                                           ##
##    Copyright (c) 2001 - 2009 by Steffen Beyer.                            ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This program is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

           #########################################################
           ##                                                     ##
           ##    See http://www.engelschall.com/~sb/calendar/     ##
           ##    for a "live" example of this CGI script.         ##
           ##                                                     ##
           #########################################################

BEGIN { eval { require bytes; }; }
use strict;

use Date::Pcalc qw(:all);
use Date::Pcalendar::Profiles qw($Profiles);
use Date::Pcalendar;

my $filler   = '<P>&nbsp;</P>';

my $RED      = '<FONT COLOR="#FF0000">';
my $PINK     = '<FONT COLOR="#CC00CC">';
my $END      = '</FONT>';

my $language = 6;
my $country  = 'NL';
my $select   = 0;
my $dispyear = 0;
my $weekend  = '';

my @DOW      = ();
my @html     = ();
my @start    = ();
my @markwend = ();
my @marksele = ();
my @markyear = ();
my @language = ();
my @sortlang = ();
my @marklang = ();
my %profiles = ();
my %sortprof = ();
my %markprof = ();
my %weekend  = ();
my %sdm      = ();

&init_tables();

&process_profiles();

&process_query_string();

&set_defaults();

&print_page();

exit 0;

sub init_tables()
{
    my $i;
    local $_;

    $html[0x00] = '';
    $html[0x01] = '';
    $html[0x02] = '';
    $html[0x03] = '';
    $html[0x04] = '';
    $html[0x05] = '';
    $html[0x06] = '';
    $html[0x07] = '';
    $html[0x08] = '';
    # $html[0x09] = '';
    # $html[0x0A] = '';
    $html[0x0B] = '';
    $html[0x0C] = '';
    $html[0x0D] = '';
    $html[0x0E] = '';

examples/calendar.pl  view on Meta::CPAN 

    $html[0xDF] = '&szlig;';
    $html[0xE0] = '&agrave;';
    $html[0xE1] = '&aacute;';
    $html[0xE2] = '&acirc;';
    $html[0xE3] = '&atilde;';
    $html[0xE4] = '&auml;';
    $html[0xE5] = '&aring;';
    $html[0xE6] = '&aelig;';
    $html[0xE7] = '&ccedil;';
    $html[0xE8] = '&egrave;';
    $html[0xE9] = '&eacute;';
    $html[0xEA] = '&ecirc;';
    $html[0xEB] = '&euml;';
    $html[0xEC] = '&igrave;';
    $html[0xED] = '&iacute;';
    $html[0xEE] = '&icirc;';
    $html[0xEF] = '&iuml;';
    $html[0xF0] = '&eth;';
    $html[0xF1] = '&ntilde;';
    $html[0xF2] = '&ograve;';
    $html[0xF3] = '&oacute;';
    $html[0xF4] = '&ocirc;';
    $html[0xF5] = '&otilde;';
    $html[0xF6] = '&ouml;';
    $html[0xF7] = '&divide;';
    $html[0xF8] = '&oslash;';
    $html[0xF9] = '&ugrave;';
    $html[0xFA] = '&uacute;';
    $html[0xFB] = '&ucirc;';
    $html[0xFC] = '&uuml;';
    $html[0xFD] = '&yacute;';
    $html[0xFE] = '&thorn;';
    $html[0xFF] = '&yuml;';
    $start[0] = [Today()];
    $start[1] = [Week_of_Year(@{$start[0]})];
    for ( $i = 1; $i <= Languages(); $i++ )
    {
        $_ = Language_to_Text($i);
        $language[$i] = html($_);
        $sortlang[$i] = iso_coll(iso_lc($_));
    }
    %sdm =
    (
        'BLN' => 'Berlin',
        'BON' => 'Bonn',
        'CGN' => 'Köln',
        'DET' => 'Detroit (USA)',
        'FFM' => 'Frankfurt a.M.',
        'HAN' => 'Hannover',
        'HH'  => 'Hamburg',
        'MUC' => 'München',
        'RAT' => 'Ratingen (Düsseldorf)',
        'STG' => 'Stuttgart',
        'ZRH' => 'Zürich (Schweiz)'
    );
    %profiles = map { $_, $_ } keys(%{$Profiles});
}

sub process_profiles()
{
    my $profile = $INC{'Date/Pcalendar/Profiles.pm'};
    my($read,$cache,$line,$key);

    $read = 1;
    if (defined($profile) and $profile ne '' and -f $profile and -r $profile and -s $profile)
    {
        $cache = $0;
        $cache =~ s!\.+[^/\\\.]*$!!;
        $cache .= ".cache";
        if (!(-f $cache and -s $cache) or ((stat($cache))[9] < (stat($profile))[9]))
        {
            if (open(PROFILE, "<$profile"))
            {
                if (open(CACHE, ">$cache"))
                {
                    while (defined ($line = <PROFILE>))
                    {
                        if ($line =~ m!^\s*\$Profiles->{'([A-Za-z]+(?:-[A-Za-z]+)?)'}\s*=\s*\#\s*(.+?)\s*$!)
                        {
                            $profiles{$1} = $2;
                        }
                    }
                    foreach $key (keys %profiles)
                    {
                        if ($key =~ m!^([A-Za-z]+)-([A-Za-z]+)$! and defined $profiles{$1})
                        {
                            if ($1 eq 'sdm')
                            {
                                $profiles{$key} = $profiles{$1} . " - " . $sdm{$2};
                            }
                            else
                            {
                                $profiles{$key} = $profiles{$1} . " - " . $profiles{$key};
                            }
                        }
                    }
                    foreach $key (sort keys(%profiles))
                    {
                        printf(CACHE "%8s => %s\n", $key, $profiles{$key});
                        $read = 0;
                    }
                    close(CACHE);
                }
                close(PROFILE);
            }
        }
    }
    if ($read and -f $cache and -r $cache and -s $cache)
    {
        if (open(CACHE, "<$cache"))
        {
            while (defined ($line = <CACHE>))
            {
                if ($line =~ m!^\s*([A-Za-z]+(?:-[A-Za-z]+)?)\s*=>\s*(.+?)\s*$!)
                {
                    $profiles{$1} = $2;
                }
            }
            close(CACHE);
        }
    }

examples/calendar.pl  view on Meta::CPAN 

<TD ALIGN="right" COLSPAN="2"><SELECT NAME="country" SIZE="10">
VERBATIM

    foreach $key (sort { $sortprof{$a} cmp $sortprof{$b} } keys(%profiles))
    {
        print qq(<OPTION VALUE="$key"$markprof{$key}>$profiles{$key}\n);
    }

    print <<"VERBATIM";
</SELECT></TD>
</TR><TR>
<TD ALIGN="right">Select by:</TD>
<TD ALIGN="right"><INPUT TYPE="radio" NAME="select" VALUE="0"$marksele[0]>&nbsp;Year and Month</TD>
<TD ALIGN="right"><INPUT TYPE="radio" NAME="select" VALUE="1"$marksele[1]>&nbsp;Week and Year</TD>
</TR><TR>
<TD ALIGN="right">$filler</TD>
<TD ALIGN="right">Year (1583..2299): <INPUT TYPE="text" SIZE="4" MAXLENGTH="4" NAME="myear" VALUE="$start[0][0]"></TD>
<TD ALIGN="right">     Week (1..53): <INPUT TYPE="text" SIZE="4" MAXLENGTH="4" NAME="week"  VALUE="$start[1][0]"></TD>
</TR><TR>
<TD ALIGN="right">$filler</TD>
<TD ALIGN="right">    Month (1..12): <INPUT TYPE="text" SIZE="4" MAXLENGTH="4" NAME="month" VALUE="$start[0][1]"></TD>
<TD ALIGN="right">Year (1583..2299): <INPUT TYPE="text" SIZE="4" MAXLENGTH="4" NAME="wyear" VALUE="$start[1][1]"></TD>
</TR><TR>
<TD ALIGN="right">Display a:</TD>
<TD ALIGN="right" COLSPAN="2">
<TABLE WIDTH="100%" CELLSPACING="0" CELLPADDING="0" BORDER="0"><TR>
<TD ALIGN="left" ><INPUT TYPE="radio" NAME="dispyear" VALUE="0"$markyear[0]>&nbsp;Month</TD>
<TD ALIGN="right"><INPUT TYPE="radio" NAME="dispyear" VALUE="1"$markyear[1]>&nbsp;Year: days off only</TD>
<TD ALIGN="right"><INPUT TYPE="radio" NAME="dispyear" VALUE="2"$markyear[2]>&nbsp;Year: all named days</TD>
</TR></TABLE>
</TD>
</TR><TR>
<TD ALIGN="right">Weekend days:</TD>
<TD ALIGN="right" COLSPAN="2">
<TABLE WIDTH="100%" CELLSPACING="0" CELLPADDING="0" BORDER="0"><TR>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="1"$markwend[1]> <TT>$DOW[1]</TT></TD>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="2"$markwend[2]> <TT>$DOW[2]</TT></TD>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="3"$markwend[3]> <TT>$DOW[3]</TT></TD>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="4"$markwend[4]> <TT>$DOW[4]</TT></TD>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="5"$markwend[5]> <TT>$DOW[5]</TT></TD>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="6"$markwend[6]> <TT>$DOW[6]</TT></TD>
<TD ALIGN="right" WIDTH="14%"><INPUT TYPE="checkbox" NAME="weekend" VALUE="7"$markwend[7]> <TT>$DOW[7]</TT></TD>
</TR></TABLE>
</TD>
</TR><TR>
<TD ALIGN="center" COLSPAN="3"><INPUT TYPE="reset" VALUE="Reset"></TD>
</TR><TR>
<TD ALIGN="center" COLSPAN="3"><INPUT TYPE="submit" VALUE="Display"></TD>
</TR><TR>
<TD ALIGN="center" COLSPAN="3">${RED}Note: Historical irregularities are (usually) not taken into account!${END}</TD>
</TR></TABLE>
</FORM>

<P>
<HR NOSHADE SIZE="2">
<P>

<TABLE CELLSPACING="1" CELLPADDING="7" BORDER="2">
VERBATIM

    &print_calendar();

    print <<"VERBATIM";
</TABLE>

<P>
<HR NOSHADE SIZE="2">
<P>

<TABLE CELLSPACING="0" CELLPADDING="8" BORDER="0"><TR>

<TD ALIGN="left">
<FORM METHOD="GET" ACTION="">
<INPUT TYPE="hidden" NAME="language" VALUE="$language">
<INPUT TYPE="hidden" NAME="country"  VALUE="$country">
<INPUT TYPE="hidden" NAME="select"   VALUE="$select">
<INPUT TYPE="hidden" NAME="myear"    VALUE="$start[3][0]">
<INPUT TYPE="hidden" NAME="week"     VALUE="$start[4][0]">
<INPUT TYPE="hidden" NAME="month"    VALUE="$start[3][1]">
<INPUT TYPE="hidden" NAME="wyear"    VALUE="$start[4][1]">
<INPUT TYPE="hidden" NAME="dispyear" VALUE="$dispyear">
<INPUT TYPE="hidden" NAME="weekend"  VALUE="$weekend">
<INPUT TYPE="submit" VALUE="&nbsp;&lt;&nbsp;&lt;&nbsp;&lt;&nbsp;">
</FORM>
</TD>

<TD WIDTH="50%">
$filler
</TD>

<TD ALIGN="right">
<FORM METHOD="GET" ACTION="">
<INPUT TYPE="hidden" NAME="language" VALUE="$language">
<INPUT TYPE="hidden" NAME="country"  VALUE="$country">
<INPUT TYPE="hidden" NAME="select"   VALUE="$select">
<INPUT TYPE="hidden" NAME="myear"    VALUE="$start[5][0]">
<INPUT TYPE="hidden" NAME="week"     VALUE="$start[6][0]">
<INPUT TYPE="hidden" NAME="month"    VALUE="$start[5][1]">
<INPUT TYPE="hidden" NAME="wyear"    VALUE="$start[6][1]">
<INPUT TYPE="hidden" NAME="dispyear" VALUE="$dispyear">
<INPUT TYPE="hidden" NAME="weekend"  VALUE="$weekend">
<INPUT TYPE="submit" VALUE="&nbsp;&gt;&nbsp;&gt;&nbsp;&gt;&nbsp;">
</FORM>
</TD>

</TR></TABLE>

<P>
<HR NOSHADE SIZE="2">
<P>

${RED}Please
<A HREF="mailto:STBEY\@cpan.org?subject=Error%20in%20calendar%20web%20page">report</A>
any errors you find on this page!${END}

<P>
<HR NOSHADE SIZE="2">
<P>

<A HREF="http://www.engelschall.com/u/sb/download/pkg/Date-Pcalc-6.1.tar.gz">Download</A>
the Perl software that does all <A HREF="calendar.pl">this</A>!

<P>
<HR NOSHADE SIZE="2">
<P>

</CENTER>
</BODY>
</HTML>
VERBATIM
}

sub print_calendar()
{
    my $year  = 0;
    my $index = 0;
    my $oyear = 0;
    my $oweek = 0;
    my $omonth = 0;
    my($calendar,$full,$half,$C,$N,$cell,$week,$dow);
    my(@date,$tags);
    local $_;

    $calendar = Date::Pcalendar->new( $Profiles->{$country}, 0, keys(%weekend) );

    print <<"VERBATIM";
<TR>
<TD COLSPAN="6" ALIGN="center"><B>$profiles{$country}</B></TD>
</TR>
<TR>
<TD ALIGN="right"><B>Year</B></TD>
<TD ALIGN="right"><B>Week<BR>Number</B></TD>
<TD ALIGN="left" ><B>Day of<BR>Week</B></TD>
<TD ALIGN="left" ><B>Month</B></TD>
<TD ALIGN="right"><B>Day</B></TD>
<TD ALIGN="left" ><B>Name</B></TD>
</TR>
VERBATIM

    @date = @{$start[0]};
    while ($start[2] > 0 and $date[0] <= 2299)
    {
        if ($date[0] >= 1583)
        {
            if ($year != $date[0])
            {
                $year  = $date[0];
                $index = $calendar->date2index(@date);
                $full  = $calendar->year($year)->vec_full();
                $half  = $calendar->year($year)->vec_half();
            }
            if ( ($dispyear == 0) or
                (($dispyear == 2) and (keys(%{$tags = $calendar->year($year)->tags($index)}))) or
                (($dispyear == 1) and ($full->bit_test($index) or $half->bit_test($index)) and not exists($weekend{Day_of_Week(@date)})))
            {
                print "<TR>\n";
                if    ($full->bit_test($index)) { $C =  $RED; $N = $END; }
                elsif ($half->bit_test($index)) { $C = $PINK; $N = $END; }
                else                            { $C =    ''; $N =   ''; }
                if ($oyear != $date[0])
                {
                    $oyear = $date[0];
                    $cell  = "<B>$oyear</B>";
                }
                else { $cell = $filler; }
                print qq(<TD ALIGN="right">$cell</TD>\n);         # Year
                $week = Week_of_Year(@date);
                if ($oweek != $week)
                {
                    $oweek = $week;
                    $cell = "<B>$week</B>";
                }
                else { $cell = $filler; }
                print qq(<TD ALIGN="right">$cell</TD>\n);         # Week Number
                $tags = $calendar->year($year)->tags($index) unless ($dispyear == 2);
                $dow = html(Day_of_Week_to_Text(Day_of_Week(@date)));
                print qq(<TD ALIGN="left" >$C$dow$N</TD>\n);      # Day of Week
                if ($omonth != $date[1])
                {
                    $omonth = $date[1];
                    $cell = "<B>" . html(Month_to_Text($omonth)) . "</B>";
                }
                else { $cell = $filler; }
                print qq(<TD ALIGN="left" >$cell</TD>\n);         # Month
                print qq(<TD ALIGN="right">$C$date[2]$N</TD>\n);  # Day
                if (keys(%$tags))
                {
                    print
                        qq(<TD ALIGN="left" >\n),                 # Name
                        join
                        (
                            "<BR>\n",
                            map
                            {
                                if    ($tags->{$_} & 2) { $RED  . html($_) . $END; }
                                elsif ($tags->{$_} & 1) { $PINK . html($_) . $END; }
                                else                    {         html($_)         }
                            }
                            keys(%$tags)
                        ),
                        qq(\n</TD>\n);
                }
                else
                {
                    print qq(<TD ALIGN="left" >$filler</TD>\n);   # Name
                }
                print "</TR>\n";
            }
        }
        if (--$start[2] > 0) { @date = Add_Delta_Days(@date,1); $index++; }
    }
}

sub html($)
{
    my $string = $_[0];
    my $o;
    $string =~ s!(.)!(defined $html[$o=ord($1)])?($html[$o]||"&\#$o;"):$1!eg;
    $string;
}

sub iso_lc($)
{
    my $string = $_[0];
    $string =~ tr/\x41-\x5A\xC0-\xD6\xD8-\xDE\x8A\x8C\x9F/\x61-\x7A\xE0-\xF6\xF8-\xFE\x9A\x9C\xFF/;
    $string;
}

sub iso_coll($)
{
    my $string = $_[0];
    $string =~ s/\xC4/Ae/g; # German
    $string =~ s/\xE4/ae/g;
    $string =~ s/\xD6/Oe/g;
    $string =~ s/\xF6/oe/g;



( run in 0.473 second using v1.01-cache-2.11-cpan-817d5f8af8b )