WAIT/Parse/Overview.pm

#                              -*- Mode: Perl -*- 
# Bibdb.pm -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Thu Sep  5 16:17:38 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Fri Dec 29 17:01:42 2000
# Language        : CPerl
# Update Count    : 75
# Status          : Unknown, Use with caution!
# 
# Copyright (c) 1996-1997, Ulrich Pfeifer
# 

package WAIT::Parse::Overview;
require WAIT::Parse::Base;
use strict;
use vars qw(@ISA);

@ISA = qw(WAIT::Parse::Base);

sub split {                     # called as method
  my %result;
  my $fld;
  
  @result{qw(article subject from to)} = (split /\t/, $_[1])[0,1,2,9];
  $result{subject} = WAIT::Filter::unmime($result{subject});
  return \%result;              # we go for speed
}


sub tag {                       # called as method
  my @result;
  my $tag;

  local $_ = $_[1];

  s/^([^\t]*\t)//; push @result, { article => 1}, $1;
  s/^([^\t]*\t)//; push @result, { subject => 1}, WAIT::Filter::unmime($1);
  s/^([^\t]*\t)//; push @result, { from    => 1}, $1;
  s/^([^\t]*\t){7,7}//; push @result, {}, $1;
  s/^([^\t]*\t)//; push @result, { to    => 1}, $1;
  
  push @result, {}, $_;
  
  return @result;               # we don't go for speed
}

package WAIT::Filter;

sub unmime {
  local($_) = @_;

  return '' unless defined $_;

  if (s/\Q=?iso-8859-1?Q?\E(.*)\?=/$1/) {
    s/_/ /g;
    s/=([0-9AF]{2,2})/pack 'C', hex($1)/eg;
  } 
  $_;
}

1;

1	# -- Mode: Perl --
2	# Bibdb.pm --
3	# ITIID : $ITI$ $Header $__Header$
4	# Author : Ulrich Pfeifer
5	# Created On : Thu Sep 5 16:17:38 1996
6	# Last Modified By: Ulrich Pfeifer
7	# Last Modified On: Fri Dec 29 17:01:42 2000
8	# Language : CPerl
9	# Update Count : 75
10	# Status : Unknown, Use with caution!
11	#
12	# Copyright (c) 1996-1997, Ulrich Pfeifer
13	#
14
15	package WAIT::Parse::Overview;
16	require WAIT::Parse::Base;
17	use strict;
18	use vars qw(@ISA);
19
20	@ISA = qw(WAIT::Parse::Base);
21
22	sub split { # called as method
23	my %result;
24	my $fld;
25
26	@result{qw(article subject from to)} = (split /\t/, $_[1])[0,1,2,9];
27	$result{subject} = WAIT::Filter::unmime($result{subject});
28	return \%result; # we go for speed
29	}
30
31
32	sub tag { # called as method
33	my @result;
34	my $tag;
35
36	local $_ = $_[1];
37
38	s/^([^\t]*\t)//; push @result, { article => 1}, $1;
39	s/^([^\t]*\t)//; push @result, { subject => 1}, WAIT::Filter::unmime($1);
40	s/^([^\t]*\t)//; push @result, { from => 1}, $1;
41	s/^([^\t]*\t){7,7}//; push @result, {}, $1;
42	s/^([^\t]*\t)//; push @result, { to => 1}, $1;
43
44	push @result, {}, $_;
45
46	return @result; # we don't go for speed
47	}
48
49	package WAIT::Filter;
50
51	sub unmime {
52	local($_) = @_;
53
54	return '' unless defined $_;
55
56	if (s/\Q=?iso-8859-1?Q?\E(.*)\?=/$1/) {
57	s/_/ /g;
58	s/=([0-9AF]{2,2})/pack 'C', hex($1)/eg;
59	}
60	$_;
61	}
62
63	1;
64