01 ###########################################
02 package ClippingsParser;
03 ###########################################
04 # Mike Schilli, 2012 (m@perlmeister.com)
05 ###########################################
06 use strict;
07 use warnings;
08 
09 ###########################################
10 sub new {
11 ###########################################
12   my( $class ) = @_;
13 
14   bless {}, $class;
15 }
16 
17 ###########################################
18 sub parse_fh {
19 ###########################################
20   my( $self, $fh, $callback ) = @_;
21 
22   my $line_sep = "==========\r\n";
23   my $entry    = "";
24   my $first    = 1;
25 
26   while( my $line = <$fh> ) {
27 
28     if( $first ) {
29         $first = 0;
30         $line =~ s/^\W+//;
31     }
32 
33     if( $line eq $line_sep ) {
34       $self->parse_entry( $entry, 
35                           $callback );
36       $entry = "";
37     } else {
38       $entry .= $line;
39     }
40   }
41 }
42 
43 ###########################################
44 sub parse_entry {
45 ###########################################
46   my( $self, $entry, $callback ) = @_;
47 
48   my( $head, $whence, $empty, $text ) = 
49       split /\r\n/, $entry, 4;
50 
51     # format error?
52   die "format error" if !defined $text;
53 
54   $text =~ s/\r\n\Z//;
55 
56   my( $title, $author ) =
57       ( $head =~ /^(.*) \((.*?)\)$/ );
58 
59     # sometimes there's no author    
60   if( !defined $author ) {
61       $author = "";
62       $title  = $head;
63   }
64 
65   my @whence = split /\s*\|\s*/, $whence;
66   my $when = pop @whence;
67   my $what = join "|", @whence;
68 
69   my( $type, $loc ) =
70       ( $what =~ /^- (\w+) (.*)/ );
71 
72   $callback->( $type, $loc, $author,
73       $title, $when, $text );
74 }
75 
76 1;