###########################################
package ClippingsParser;
###########################################
# Mike Schilli, 2012 (m@perlmeister.com)
###########################################
use strict;
use warnings;

###########################################
sub new {
###########################################
  my( $class ) = @_;

  bless {}, $class;
}

###########################################
sub parse_fh {
###########################################
  my( $self, $fh, $callback ) = @_;

  my $line_sep = "==========\r\n";
  my $entry    = "";
  my $first    = 1;

  while( my $line = <$fh> ) {

    if( $first ) {
        $first = 0;
        $line =~ s/^\W+//;
    }

    if( $line eq $line_sep ) {
      $self->parse_entry( $entry, 
                          $callback );
      $entry = "";
    } else {
      $entry .= $line;
    }
  }
}

###########################################
sub parse_entry {
###########################################
  my( $self, $entry, $callback ) = @_;

  my( $head, $whence, $empty, $text ) = 
      split /\r\n/, $entry, 4;

    # format error?
  die "format error" if !defined $text;

  $text =~ s/\r\n\Z//;

  my( $title, $author ) =
      ( $head =~ /^(.*) \((.*?)\)$/ );

    # sometimes there's no author    
  if( !defined $author ) {
      $author = "";
      $title  = $head;
  }

  my @whence = split /\s*\|\s*/, $whence;
  my $when = pop @whence;
  my $what = join "|", @whence;

  my( $type, $loc ) =
      ( $what =~ /^- (\w+) (.*)/ );

  $callback->( $type, $loc, $author,
      $title, $when, $text );
}

1;