Skip to content
Browse files

Initial commit

  • Loading branch information...
0 parents commit cdeda29e53b1c6b6cf96f5cc4656fa8df3ae8a15 @davorg committed
Showing with 151 additions and 0 deletions.
  1. +19 −0 Build.PL
  2. +39 −0 README
  3. +82 −0 lib/FreeBMD/Events.pm
  4. +3 −0 t/01-basic.t
  5. +4 −0 t/02-pod.t
  6. +4 −0 t/03-pod_coverage.t
19 Build.PL
@@ -0,0 +1,19 @@
+use Module::Build;
+
+my $build = Module::Build->new(
+ module_name => 'FreeBMD::Events',
+ license => 'perl',
+ requires => {
+ 'perl' => '5.008',
+ },
+ build_requires => {
+ 'Test::More' => '0.47',
+ },
+ build_recommends => {
+ 'Test::Pod' => 0,
+ 'Test::Pod::Coverage' => 0,
+ },
+ create_makefile_pl => 'traditional',
+);
+
+$build->create_build_script;
39 README
@@ -0,0 +1,39 @@
+FreeBMD-Events version 0.01
+===========================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ LWP::UserAgent
+ Moose
+
+COPYRIGHT AND LICENCE
+
+Copyright (c) Magnum Solutions Ltd., 2009. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.000 or,
+at your option, any later version of Perl 5 you may have available.
+
+
82 lib/FreeBMD/Events.pm
@@ -0,0 +1,82 @@
+package FreeBMD::Events;
+
+use strict;
+use warnings;
+
+use CGI 'unescape';
+use Carp;
+
+our $VERSION = '0.01';
+
+my @types = qw(B D M);
+
+sub parse {
+ my $class = shift;
+ my $file = shift;
+
+ open my $fh, '<', $file or croak "$file: $!";
+
+ $_ = do { local $/; <$fh> };
+
+ my ($text) = /var searchData = new Array \(\s*\n(.+?)\)/s;
+
+ my @data = map { s/^"//; s/",$//; $_ } split /\n/, unescape $text;
+
+ my %prev;
+ my @events;
+ while (my @rec = splice @data, 0, 2) {
+ my %cur;
+ @cur{'type', 'qtr', 'year'} = (split /;/, $rec[0])[1, 2 ,3];
+ @cur{'surname', 'forename', 'age', 'district', 'volume', 'page'} =
+ (split /;/, $rec[1])[1,2,3,5,6,7];
+
+ $cur{type} = $types[$cur{type}];
+ $cur{qtr} = "Q$cur{qtr}";
+
+ for (keys %cur) {
+ $cur{$_} ||= $prev{$_} || '';
+ delete $cur{$_} unless $cur{$_} =~ /\S/;
+ }
+
+ %prev = %cur;
+
+ push @events, FreeBMD::Event->new(\%cur);
+
+ if (@data && $data[0] =~ /^\d/) {
+ $rec[1] = shift @data;
+ redo;
+ }
+ }
+
+ return @events;
+}
+
+package FreeBMD::Event;
+
+use Moose;
+
+has 'type' => (is => 'rw', isa => 'Str', required => 1);
+has 'qtr' => (is => 'rw', isa => 'Str', required => 1);
+has 'year' => (is => 'rw', isa => 'Int', required => 1);
+has 'surname' => (is => 'rw', isa => 'Str', required => 1);
+has 'forename' => (is => 'rw', isa => 'Str', required => 1);
+has 'age' => (is => 'rw', isa => 'Int');
+has 'district' => (is => 'rw', isa => 'Str', required => 1);
+has 'volume' => (is => 'rw', isa => 'Str', required => 1);
+has 'page' => (is => 'rw', isa => 'Str', required => 1);
+
+my $template = '[ type ] Q[ qtr ] [ year ]
+[ surname ] [ forename ]
+[ district ] [ volume ] [ page ]';
+
+sub to_string {
+ my $self = shift;
+
+ my $string = $template;
+
+ $string =~ s/\[\s*(\w+)\s+]/$self->$1/eg;
+
+ return $string;
+}
+
+1;
3 t/01-basic.t
@@ -0,0 +1,3 @@
+use Test::More 'no_plan';
+
+use_ok('FreeBMD::Events');
4 t/02-pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
4 t/03-pod_coverage.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+all_pod_coverage_ok();

0 comments on commit cdeda29

Please sign in to comment.
Something went wrong with that request. Please try again.