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