[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Date / Calc.pm


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

package Date::Calc;

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

require Exporter;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);

@EXPORT = qw();

@EXPORT_OK = qw(
    Days_in_Year
    Days_in_Month
    Weeks_in_Year
    leap_year
    check_date
    check_time
    check_business_date
    Day_of_Year
    Date_to_Days
    Day_of_Week
    Week_Number
    Week_of_Year
    Monday_of_Week
    Nth_Weekday_of_Month_Year
    Standard_to_Business
    Business_to_Standard
    Delta_Days
    Delta_DHMS
    Delta_YMD
    Delta_YMDHMS
    Normalize_DHMS
    Add_Delta_Days
    Add_Delta_DHMS
    Add_Delta_YM
    Add_Delta_YMD
    Add_Delta_YMDHMS
    System_Clock
    Today
    Now
    Today_and_Now
    This_Year
    Gmtime
    Localtime
    Mktime
    Timezone
    Date_to_Time
    Time_to_Date
    Easter_Sunday
    Decode_Month
    Decode_Day_of_Week
    Decode_Language
    Decode_Date_EU
    Decode_Date_US
    Fixed_Window
    Moving_Window
    Compress
    Uncompress
    check_compressed
    Compressed_to_Text
    Date_to_Text
    Date_to_Text_Long
    English_Ordinal
    Calendar
    Month_to_Text
    Day_of_Week_to_Text
    Day_of_Week_Abbreviation
    Language_to_Text
    Language
    Languages
    Decode_Date_EU2
    Decode_Date_US2
    Parse_Date
    ISO_LC
    ISO_UC
);

%EXPORT_TAGS = (all => [@EXPORT_OK]);

##################################################
##                                              ##
##  "Version()" is available but not exported   ##
##  in order to avoid possible name clashes.    ##
##  Call with "Date::Calc::Version()" instead!  ##
##                                              ##
##################################################

$VERSION = '5.3';

bootstrap Date::Calc $VERSION;

sub Decode_Date_EU2
{
    die "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date);\n"
      if (@_ != 1);

    my($buffer) = @_;
    my($year,$month,$day,$length);

    if ($buffer =~ /^\D*  (\d+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D*$/x)
    {
        ($day,$month,$year) = ($1,$2,$3);
        $month = Decode_Month($month);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
    }
    elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
    {
        $buffer = $1;
        $length = length($buffer);
        if    ($length == 3)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,1);
            $year  = substr($buffer,2,1);
        }
        elsif ($length == 4)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,1);
            $year  = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,2);
            $year  = substr($buffer,3,2);
        }
        elsif ($length == 6)
        {
            $day   = substr($buffer,0,2);
            $month = substr($buffer,2,2);
            $year  = substr($buffer,4,2);
        }
        elsif ($length == 7)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,2);
            $year  = substr($buffer,3,4);
        }
        elsif ($length == 8)
        {
            $day   = substr($buffer,0,2);
            $month = substr($buffer,2,2);
            $year  = substr($buffer,4,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($day,$month,$year) = ($1,$2,$3);
    }
    else { return(); } # no match at all!
    $year = Moving_Window($year);
    if (check_date($year,$month,$day))
    {
        return($year,$month,$day);
    }
    else { return(); } # not a valid date!
}

sub Decode_Date_US2
{
    die "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date);\n"
      if (@_ != 1);

    my($buffer) = @_;
    my($year,$month,$day,$length);

    if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  0*(\d+)  \D*$/x)
    {
        ($month,$buffer) = ($1,$2);
        $month = Decode_Month($month);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
        $length = length($buffer);
        if    ($length == 2)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,1);
        }
        elsif ($length == 3)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,2);
        }
        elsif ($length == 4)
        {
            $day  = substr($buffer,0,2);
            $year = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,4);
        }
        elsif ($length == 6)
        {
            $day  = substr($buffer,0,2);
            $year = substr($buffer,2,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($month,$day,$year) = ($1,$2,$3);
        $month = Decode_Month($month);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
    }
    elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
    {
        $buffer = $1;
        $length = length($buffer);
        if    ($length == 3)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,1);
            $year  = substr($buffer,2,1);
        }
        elsif ($length == 4)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,1);
            $year  = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,2);
            $year  = substr($buffer,3,2);
        }
        elsif ($length == 6)
        {
            $month = substr($buffer,0,2);
            $day   = substr($buffer,2,2);
            $year  = substr($buffer,4,2);
        }
        elsif ($length == 7)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,2);
            $year  = substr($buffer,3,4);
        }
        elsif ($length == 8)
        {
            $month = substr($buffer,0,2);
            $day   = substr($buffer,2,2);
            $year  = substr($buffer,4,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($month,$day,$year) = ($1,$2,$3);
    }
    else { return(); } # no match at all!
    $year = Moving_Window($year);
    if (check_date($year,$month,$day))
    {
        return($year,$month,$day);
    }
    else { return(); } # not a valid date!
}

sub Parse_Date
{
    die "Usage: (\$year,\$month,\$day) = Parse_Date(\$date);\n"
      if (@_ != 1);

    my($date) = @_;
    my($year,$month,$day);
    unless ($date =~ /\b([JFMASOND][aepuco][nbrynlgptvc])\s+([0123]??\d)\b/)
    {
        return();
    }
    $month = $1;
    $day   = $2;
    unless ($date =~ /\b(19\d\d|20\d\d)\b/)
    {
        return();
    }
    $year  = $1;
    $month = Decode_Month($month);
    unless ($month > 0)
    {
        return();
    }
    unless (check_date($year,$month,$day))
    {
        return();
    }
    return($year,$month,$day);
}

1;

__END__
Commit	Line	Data
86530b38 AT	1
	2	###############################################################################
	3	## ##
	4	## Copyright (c) 1995 - 2002 by Steffen Beyer. ##
	5	## All rights reserved. ##
	6	## ##
	7	## This package is free software; you can redistribute it ##
	8	## and/or modify it under the same terms as Perl itself. ##
	9	## ##
	10	###############################################################################
	11
	12	package Date::Calc;
	13
	14	use strict;
	15	use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
	16
	17	require Exporter;
	18	require DynaLoader;
	19
	20	@ISA = qw(Exporter DynaLoader);
	21
	22	@EXPORT = qw();
	23
	24	@EXPORT_OK = qw(
	25	Days_in_Year
	26	Days_in_Month
	27	Weeks_in_Year
	28	leap_year
	29	check_date
	30	check_time
	31	check_business_date
	32	Day_of_Year
	33	Date_to_Days
	34	Day_of_Week
	35	Week_Number
	36	Week_of_Year
	37	Monday_of_Week
	38	Nth_Weekday_of_Month_Year
	39	Standard_to_Business
	40	Business_to_Standard
	41	Delta_Days
	42	Delta_DHMS
	43	Delta_YMD
	44	Delta_YMDHMS
	45	Normalize_DHMS
	46	Add_Delta_Days
	47	Add_Delta_DHMS
	48	Add_Delta_YM
	49	Add_Delta_YMD
	50	Add_Delta_YMDHMS
	51	System_Clock
	52	Today
	53	Now
	54	Today_and_Now
	55	This_Year
	56	Gmtime
	57	Localtime
	58	Mktime
	59	Timezone
	60	Date_to_Time
	61	Time_to_Date
	62	Easter_Sunday
	63	Decode_Month
	64	Decode_Day_of_Week
65	Decode_Language
66	Decode_Date_EU
67	Decode_Date_US
68	Fixed_Window
69	Moving_Window
70	Compress
71	Uncompress
72	check_compressed
73	Compressed_to_Text
74	Date_to_Text
75	Date_to_Text_Long
76	English_Ordinal
77	Calendar
78	Month_to_Text
79	Day_of_Week_to_Text
80	Day_of_Week_Abbreviation
81	Language_to_Text
82	Language
83	Languages
84	Decode_Date_EU2
85	Decode_Date_US2
86	Parse_Date
87	ISO_LC
88	ISO_UC
89	);
90
91	%EXPORT_TAGS = (all => [@EXPORT_OK]);
92
93	##################################################
94	## ##
95	## "Version()" is available but not exported ##
96	## in order to avoid possible name clashes. ##
97	## Call with "Date::Calc::Version()" instead! ##
98	## ##
99	##################################################
100
101	$VERSION = '5.3';
102
103	bootstrap Date::Calc $VERSION;
104
105	sub Decode_Date_EU2
106	{
107	die "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date);\n"
108	if (@_ != 1);
109
110	my($buffer) = @_;
111	my($year,$month,$day,$length);
112
113	if ($buffer =~ /^\D* (\d+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D*$/x)
114	{
115	($day,$month,$year) = ($1,$2,$3);
116	$month = Decode_Month($month);
117	unless ($month > 0)
118	{
119	return(); # can't decode month!
120	}
121	}
122	elsif ($buffer =~ /^\D* 0(\d+) \D$/x)
123	{
124	$buffer = $1;
125	$length = length($buffer);
126	if ($length == 3)
127	{
128	$day = substr($buffer,0,1);
129	$month = substr($buffer,1,1);
130	$year = substr($buffer,2,1);
131	}
132	elsif ($length == 4)
133	{
134	$day = substr($buffer,0,1);
135	$month = substr($buffer,1,1);
136	$year = substr($buffer,2,2);
137	}
138	elsif ($length == 5)
139	{
140	$day = substr($buffer,0,1);
141	$month = substr($buffer,1,2);
142	$year = substr($buffer,3,2);
143	}
144	elsif ($length == 6)
145	{
146	$day = substr($buffer,0,2);
147	$month = substr($buffer,2,2);
148	$year = substr($buffer,4,2);
149	}
150	elsif ($length == 7)
151	{
152	$day = substr($buffer,0,1);
153	$month = substr($buffer,1,2);
154	$year = substr($buffer,3,4);
155	}
156	elsif ($length == 8)
157	{
158	$day = substr($buffer,0,2);
159	$month = substr($buffer,2,2);
160	$year = substr($buffer,4,4);
161	}
162	else { return(); } # wrong number of digits!
163	}
164	elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x)
165	{
166	($day,$month,$year) = ($1,$2,$3);
167	}
168	else { return(); } # no match at all!
169	$year = Moving_Window($year);
170	if (check_date($year,$month,$day))
171	{
172	return($year,$month,$day);
173	}
174	else { return(); } # not a valid date!
175	}
176
177	sub Decode_Date_US2
178	{
179	die "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date);\n"
180	if (@_ != 1);
181
182	my($buffer) = @_;
183	my($year,$month,$day,$length);
184
185	if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* 0(\d+) \D$/x)
186	{
187	($month,$buffer) = ($1,$2);
188	$month = Decode_Month($month);
189	unless ($month > 0)
190	{
191	return(); # can't decode month!
192	}
193	$length = length($buffer);
194	if ($length == 2)
195	{
196	$day = substr($buffer,0,1);
197	$year = substr($buffer,1,1);
198	}
199	elsif ($length == 3)
200	{
201	$day = substr($buffer,0,1);
202	$year = substr($buffer,1,2);
203	}
204	elsif ($length == 4)
205	{
206	$day = substr($buffer,0,2);
207	$year = substr($buffer,2,2);
208	}
209	elsif ($length == 5)
210	{
211	$day = substr($buffer,0,1);
212	$year = substr($buffer,1,4);
213	}
214	elsif ($length == 6)
215	{
216	$day = substr($buffer,0,2);
217	$year = substr($buffer,2,4);
218	}
219	else { return(); } # wrong number of digits!
220	}
221	elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D+ (\d+) \D*$/x)
222	{
223	($month,$day,$year) = ($1,$2,$3);
224	$month = Decode_Month($month);
225	unless ($month > 0)
226	{
227	return(); # can't decode month!
228	}
229	}
230	elsif ($buffer =~ /^\D* 0(\d+) \D$/x)
231	{
232	$buffer = $1;
233	$length = length($buffer);
234	if ($length == 3)
235	{
236	$month = substr($buffer,0,1);
237	$day = substr($buffer,1,1);
238	$year = substr($buffer,2,1);
239	}
240	elsif ($length == 4)
241	{
242	$month = substr($buffer,0,1);
243	$day = substr($buffer,1,1);
244	$year = substr($buffer,2,2);
245	}
246	elsif ($length == 5)
247	{
248	$month = substr($buffer,0,1);
249	$day = substr($buffer,1,2);
250	$year = substr($buffer,3,2);
251	}
252	elsif ($length == 6)
253	{
254	$month = substr($buffer,0,2);
255	$day = substr($buffer,2,2);
256	$year = substr($buffer,4,2);
257	}
258	elsif ($length == 7)
259	{
260	$month = substr($buffer,0,1);
261	$day = substr($buffer,1,2);
262	$year = substr($buffer,3,4);
263	}
264	elsif ($length == 8)
265	{
266	$month = substr($buffer,0,2);
267	$day = substr($buffer,2,2);
268	$year = substr($buffer,4,4);
269	}
270	else { return(); } # wrong number of digits!
271	}
272	elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x)
273	{
274	($month,$day,$year) = ($1,$2,$3);
275	}
276	else { return(); } # no match at all!
277	$year = Moving_Window($year);
278	if (check_date($year,$month,$day))
279	{
280	return($year,$month,$day);
281	}
282	else { return(); } # not a valid date!
283	}
284
285	sub Parse_Date
286	{
287	die "Usage: (\$year,\$month,\$day) = Parse_Date(\$date);\n"
288	if (@_ != 1);
289
290	my($date) = @_;
291	my($year,$month,$day);
292	unless ($date =~ /\b([JFMASOND][aepuco][nbrynlgptvc])\s+([0123]??\d)\b/)
293	{
294	return();
295	}
296	$month = $1;
297	$day = $2;
298	unless ($date =~ /\b(19\d\d\|20\d\d)\b/)
299	{
300	return();
301	}
302	$year = $1;
303	$month = Decode_Month($month);
304	unless ($month > 0)
305	{
306	return();
307	}
308	unless (check_date($year,$month,$day))
309	{
310	return();
311	}
312	return($year,$month,$day);
313	}
314
315	1;
316
317	__END__
318