1# $Revision: 1.16 $
2# $Id: Entry.pm,v 1.16 2002/07/22 08:35:43 afoxson Exp $
3
4# Mail::Freshmeat::Entry - parses entries from freshmeat daily newsletters
5# Copyright (c) 2002 Adam J. Foxson. All rights reserved.
6
7# This program is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2 of the License, or
10# (at your option) any later version.
11
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16
17package Mail::Freshmeat::Entry;
18
19use strict;
20use 5.005;
21use Carp;
22use vars qw($VERSION $AUTOLOAD);
23use Mail::Freshmeat::Utils;
24
25local $^W;
26
27($VERSION) = '$Revision: 1.16 $' =~ /\s+(\d+\.\d+)\s+/;
28
29sub new
30{
31	my $type  = shift;
32	my $entry = shift or croak "I need to be passed an entry.";
33	my $count = shift or croak "I need to be passed a count.";
34	my $class = ref($type) || $type;
35	my $self  = bless {}, $class;
36
37	$self->{_attrs} =
38	[
39		qw
40		(
41			_position _name_and_version _name _version _posted_by_name
42			_posted_by_url _posted_on _trove _about _changes _license _url
43		)
44	];
45
46	# these are the allowed entry accessors
47	$self->{_is_attr} = {map {$_ => 1} @{$self->{_attrs}}, '_full'};
48	$self->_parse($entry, $count);
49
50	return $self;
51}
52
53sub entry_keys
54{
55	my $self = shift;
56	wantarray ? @{$self->{_attrs}} : $self->{_attrs};
57}
58
59sub _parse
60{
61	my $self  = shift;
62	my $entry = shift or croak "I need to be passed an entry.";
63	my $count = shift or croak "I need to be passed a count.";
64	my @entries;
65
66	if ($entry =~
67	/
68		^ \s* \[(\d+)\] \s-\s (.*) $ \n
69		^ (\s* .* \)) \s* by\s(.*) \s \((.*)\) $ \n
70		^ \s* ( \w+ , \s \w+ \s \d{1,2} \w{2} \s \d{4} \s \d{2}:\d{2} ) $ \n
71
72		(?:
73			$_blank_line
74			(?s: (?:Category:\s|Categories:\s)? (.+?) \n )
75		)?
76		$_blank_line
77		(?s: About:\s (.+?) \n )
78		(?:
79			$_blank_line
80			(?s: Changes:\s (.+?) \n )
81		)?
82		$_blank_line
83		^ \s* License:\s (.*) $ \n
84		$_blank_line
85		^ \s* URL:\s (.*) $
86	/mx)
87	{
88		$self->{_position}         = $1;
89		$self->{_name_and_version} = $2 . $3;
90		$self->{_posted_by_name}   = $4;
91		$self->{_posted_by_url}    = $5;
92		$self->{_posted_on}        = $6;
93		$self->{_trove}            = $7;
94		$self->{_about}            = $8;
95		$self->{_changes}          = $9;
96		$self->{_license}          = $10;
97		$self->{_url}              = $11;
98		$self->{_full}             = $entry;
99	}
100	elsif ($entry =~
101	/
102		^ \s* \[(\d+)\] \s-\s (.*) $ \n
103		^ \s* by\s(.*) \s \((.*)\) $ \n
104		^ \s* ( \w+ , \s \w+ \s \d{1,2} \w{2} \s \d{4} \s \d{2}:\d{2} ) $ \n
105
106		(?:
107			$_blank_line
108			(?s: (?:Category:\s|Categories:\s)? (.+?) \n )
109		)?
110		$_blank_line
111		(?s: About:\s (.+?) \n )
112		(?:
113			$_blank_line
114			(?s: Changes:\s (.+?) \n )
115		)?
116		$_blank_line
117		^ \s* License:\s (.*) $ \n
118		$_blank_line
119		^ \s* URL:\s (.*) $
120	/mx)
121	{
122		$self->{_position}         = $1;
123		$self->{_name_and_version} = $2;
124		$self->{_posted_by_name}   = $3;
125		$self->{_posted_by_url}    = $4;
126		$self->{_posted_on}        = $5;
127		$self->{_trove}            = $6;
128		$self->{_about}            = $7;
129		$self->{_changes}          = $8;
130		$self->{_license}          = $9;
131		$self->{_url}              = $10;
132		$self->{_full}             = $entry;
133	}
134	elsif ($entry =~
135	/
136		^ \s* \[(\d+)\] \s-\s (.*) $ \n
137		^ \s* by\s(.*) $ \n
138		^ (\s* .*) $ \n
139		^ \s* ( \w+ , \s \w+ \s \d{1,2} \w{2} \s \d{4} \s \d{2}:\d{2} ) $ \n
140
141		(?:
142			$_blank_line
143			(?s: (?:Category:\s|Categories:\s)? (.+?) \n )
144		)?
145		$_blank_line
146		(?s: About:\s (.+?) \n )
147		(?:
148			$_blank_line
149			(?s: Changes:\s (.+?) \n )
150		)?
151		$_blank_line
152		^ \s* License:\s (.*) $ \n
153		$_blank_line
154		^ \s* URL:\s (.*) $
155	/mx)
156	{
157		$self->{_position}         = $1;
158		$self->{_name_and_version} = $2;
159		$self->{_posted_by_name}   = $3 . $4;
160		$self->{_posted_on}        = $5;
161		$self->{_trove}            = $6;
162		$self->{_about}            = $7;
163		$self->{_changes}          = $8;
164		$self->{_license}          = $9;
165		$self->{_url}              = $10;
166		$self->{_full}             = $entry;
167
168		($self->{_posted_by_name}, $self->{_posted_by_url}) =
169			$self->{_posted_by_name} =~ /(.*) \s \((.*)\)/;
170	}
171	else
172	{
173		_fatal_bug("Couldn't parse entry $count (entries).");
174	}
175
176	@$self{qw/_name _version/} =
177		$self->_parse_entry_version($self);
178
179	for my $key (keys %$self)
180	{
181		$self->{$key} = '' if not defined $self->{$key};
182	}
183
184	if ($self->position() != $count)
185	{
186		_fatal_bug("Detcted an entry with an incorrect position " .
187			"(${\($self->position())}/$count).");
188	}
189
190	return $self;
191}
192
193# TODO: One day this will probably be have to be re-written. As it is now
194# it parses the very vast majority name-version's successfully, but I'd
195# like to get it to 100%
196sub _parse_entry_version
197{
198	my $self = shift;
199
200	# Start of first word of version must match this
201	my $version_first_word_start = qr
202	/
203		(
204			[.\d]           |
205			pre             |
206			alpha           |
207			beta            |
208			patch           |
209			r               |
210			rel             |
211			release         |
212			build           |
213			v(?:er)? [^a-z]
214		)
215	/ix;
216
217	# Start of further words of version must match this
218	my $version_other_words_start = qr
219	/
220		(
221			[.\d(]          |
222			pre             |
223			alpha           |
224			beta            |
225			r               |
226			rel             |
227			release         |
228			build           |
229			patch
230		)
231	/ix;
232
233	# Rest of each word of version must match this
234	my $version_rest_of_word = qr
235	/
236		(
237			[.\w()\/-]      |
238			pre             |
239			alpha           |
240			beta            |
241			patch           |
242			\d{1,6}(?!\d)       # not more than six digits
243								# in a row
244		)*
245	/ix;
246
247	my ($name, $version) = ($self->{_name_and_version}, '');
248
249	if ($self->{_name_and_version} =~
250	/^
251		(.+?)
252		\s+
253		(
254			$version_first_word_start
255			$version_rest_of_word
256			(?:
257				\s+
258				$version_other_words_start
259				$version_rest_of_word
260			)*
261		)
262	$/ix)
263	{
264		$name    = $1;
265		$version = $2;
266	}
267
268	return ($name, $version);
269}
270
271sub short_entry
272{
273	my $self = shift;
274	return $self->position(), " - ", $self->name_and_version();
275}
276
277sub AUTOLOAD
278{
279	my $self = $_[0];
280	my ($package, $method) = ($AUTOLOAD =~ /(.*)::(.*)/);
281
282	return if $method =~ /^DESTROY$/;
283	unless ($self->{_is_attr}->{"_$method"})
284	{
285		croak "No such entry accessor entry: $method; aborting";
286	}
287
288	my $code = q
289	{
290		sub
291		{
292			my $self = shift;
293			return $self->{_METHOD};
294		}
295	};
296
297	$code =~ s/METHOD/$method/g;
298
299	{
300		no strict 'refs';
301		*$AUTOLOAD = eval $code;
302	}
303
304	goto &$AUTOLOAD;
305}
306
3071;
308