TracTicket.pm のCentOS4.x対応版

TracTicket.pm のCentOS4.x対応版。 CentOS4.x で使える、LWP::UserAgentでは以下のほうを使ってください。

package TracTicket;

use warnings;
use strict;
use LWP::UserAgent;
use HTTP::Headers;
use HTTP::Request::Common;
use MIME::Base64;
use Data::Dumper;

sub new {
	my $classname = shift;
	my $url = shift;
	my $username = shift;
	my $password = shift;
	
	my $ua = LWP::UserAgent->new;
	my $req = HTTP::Request->new(GET => $url);
	$req->authorization_basic($username, $password);

	my $res = $ua->request($req);

	my @setcookie = $res->header('Set-Cookie');

	my $trac_form_token;
	my $trac_session;
	foreach (@setcookie) {
		if( /trac_form_token=([0-9A-z]+);/ ) {
			$trac_form_token = $1;
		}
		elsif( /trac_session=([0-9A-z]+);/ ) {
			$trac_session = $1;
		}
	}
	
	my $cookie;
	if( $trac_session ) {
		$cookie = "trac_form_token=$trac_form_token; trac_session=$trac_session";
	}
	else {
		$cookie = "trac_form_token=$trac_form_token";
	}
	
	my $formdata = {
		__FORM_TOKEN => $trac_form_token,
		reporter => ($username)?$username:'TracTicket',
		summary => 'none',
		type => 'defect',
		description => 'none',
		priority => 'major',
		owner => ($username)?$username:'',
		status => 'new',
		action => 'create',
	};

	bless {
		url => $url,
		trac_form_token => $trac_form_token,
		trac_session => $trac_session,
		username => $username,
		password => $password,
		ua => $ua,
		formdata => $formdata,
		cookie => $cookie,
	}, $classname;
}

sub set_formdata {
	my $self = shift;
	my $key = shift;
	my $value = shift;
	$self->{formdata}->{ $key } = $value;
}

sub submit {
	my $self = shift;
	my $req  = POST( $self->{url}, $self->{formdata});
	$req->header("Cookie"=>$self->{cookie});
	$req->authorization_basic( $self->{username}, $self->{password});
	my $res = $self->{ua}->request($req);
}

1;
__END__