=head1 NAME

URI::URL::MID Perl module

=head1 DESCRIPTION

Perl module for Message-ID URL scheme (C<mid:>),
defined by RFC 2111, RFC 2392.

=cut

package URI::URL::MID;
use strict;
use vars qw($VERSION);
$VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
use overload '""' => sub {shift->stringify};
use Message::Field::MsgID::MsgID;

=head2 URI::URL::MID->new ()

Makes new C<mid:> URI.

=cut

sub new ($;%) {
  my $self = bless {}, shift;
  $self;
}

=head2 URI::URL::MID->parse ($uri)

Parses C<mid:> URI.

=cut

sub parse ($$;%) {
  my $self = bless {}, shift;
  my $uri = shift;
  if ($uri =~ s/^[Cc][Ii][Dd]://) {
    $self->{cid} = Message::Field::MsgID::MsgID->parse ($uri, field_name => 'cid');
  } elsif ($uri =~ s/^[Mm][Ii][Dd]://) {
    my ($mid, $cid) = split q{/}, $uri, 2;
    $mid =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
    $cid =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
    $self->{mid} = Message::Field::MsgID::MsgID->parse ($mid) if $mid;
    $self->{cid} = Message::Field::MsgID::MsgID->parse ($cid, field_name => 'cid')
       if $cid;
  }
  $self;
}

sub message_id ($;$) {
  my $self = shift;
  my $new_mid = shift;
  if (ref $new_mid) {
    $self->{mid} = $new_mid;
  } elsif ($new_mid) {
    $self->{mid} = Message::Field::MsgID::MsgID->parse ($new_mid);
  }
  $self->{mid};
}

sub content_id ($;$) {
  my $self = shift;
  my $new_cid = shift;
  if (ref $new_cid) {
    $self->{cid} = $new_cid;
  } elsif ($new_cid) {
    $self->{cid} = parse Message::Field::MsgID::MsgID ($new_cid);
  }
  $self->{cid};
}

sub stringify ($;%) {
  my $self = shift;
  my %option = @_;
  my ($mid, $cid) = ($self->{mid}, $self->{cid});
  undef $mid if $option{scheme} eq 'cid';
  $mid = $mid->content if ref $mid;
  $cid = $cid->content if ref $cid;
  return '' if !$mid && !$cid;
  $mid =~ s/([^;?:@=+\$,A-Za-z0-9\-_.!~*()])/sprintf('%%%02X', ord $1)/ge;
  $cid =~ s/([^;?:@=+\$,A-Za-z0-9\-_.!~*()])/sprintf('%%%02X', ord $1)/ge;
  return 'cid:'.$cid unless $mid;
  'mid:'.$mid.($cid? '/'.$cid: '');
}
sub as_string ($;%) {shift->stringify (@_)}

=head1 EXAMPLE

  use URI::URL::MID;
  
  ## Message-ID -> URI
  my $mid1 = new URI::URL::MID;
  $mid1->message_id ('<foo1@bar.example>');
  $mid1->content_id ('<foo2@bar.example>');
  print $mid1;
  
  ## URI -> Message-ID
  my $mid2 = URI::URL::MID->parse ('mid:foo3@bar.example');
  print $mid2->message_id;

=head1 LICENSE

Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

=head1 CHANGE

See F<ChangeLog>.
$Date: 2002/03/20 11:41:25 $

=cut

1;