diff options
Diffstat (limited to 'Bugzilla/Migrate/Gnats.pm')
| -rw-r--r-- | Bugzilla/Migrate/Gnats.pm | 1034 |
1 files changed, 530 insertions, 504 deletions
diff --git a/Bugzilla/Migrate/Gnats.pm b/Bugzilla/Migrate/Gnats.pm index 5feda4b8d..a5aa642e1 100644 --- a/Bugzilla/Migrate/Gnats.pm +++ b/Bugzilla/Migrate/Gnats.pm @@ -25,88 +25,87 @@ use List::MoreUtils qw(firstidx); use List::Util qw(first); use constant REQUIRED_MODULES => [ - { - package => 'Email-Simple-FromHandle', - module => 'Email::Simple::FromHandle', - # This version added seekable handles. - version => 0.050, - }, + { + package => 'Email-Simple-FromHandle', + module => 'Email::Simple::FromHandle', + + # This version added seekable handles. + version => 0.050, + }, ]; use constant FIELD_MAP => { - 'Number' => 'bug_id', - 'Category' => 'product', - 'Synopsis' => 'short_desc', - 'Responsible' => 'assigned_to', - 'State' => 'bug_status', - 'Class' => 'cf_type', - 'Classification' => '', - 'Originator' => 'reporter', - 'Arrival-Date' => 'creation_ts', - 'Last-Modified' => 'delta_ts', - 'Release' => 'version', - 'Severity' => 'bug_severity', - 'Description' => 'comment', + 'Number' => 'bug_id', + 'Category' => 'product', + 'Synopsis' => 'short_desc', + 'Responsible' => 'assigned_to', + 'State' => 'bug_status', + 'Class' => 'cf_type', + 'Classification' => '', + 'Originator' => 'reporter', + 'Arrival-Date' => 'creation_ts', + 'Last-Modified' => 'delta_ts', + 'Release' => 'version', + 'Severity' => 'bug_severity', + 'Description' => 'comment', }; use constant VALUE_MAP => { - bug_severity => { - 'serious' => 'major', - 'cosmetic' => 'trivial', - 'new-feature' => 'enhancement', - 'non-critical' => 'normal', - }, - bug_status => { - 'open' => 'CONFIRMED', - 'analyzed' => 'IN_PROGRESS', - 'suspended' => 'RESOLVED', - 'feedback' => 'RESOLVED', - 'released' => 'VERIFIED', - }, - bug_status_resolution => { - 'feedback' => 'FIXED', - 'released' => 'FIXED', - 'closed' => 'FIXED', - 'suspended' => 'LATER', - }, - priority => { - 'medium' => 'Normal', - }, + bug_severity => { + 'serious' => 'major', + 'cosmetic' => 'trivial', + 'new-feature' => 'enhancement', + 'non-critical' => 'normal', + }, + bug_status => { + 'open' => 'CONFIRMED', + 'analyzed' => 'IN_PROGRESS', + 'suspended' => 'RESOLVED', + 'feedback' => 'RESOLVED', + 'released' => 'VERIFIED', + }, + bug_status_resolution => { + 'feedback' => 'FIXED', + 'released' => 'FIXED', + 'closed' => 'FIXED', + 'suspended' => 'LATER', + }, + priority => {'medium' => 'Normal',}, }; use constant GNATS_CONFIG_VARS => ( - { - name => 'gnats_path', - default => '/var/lib/gnats', - desc => <<END, + { + name => 'gnats_path', + default => '/var/lib/gnats', + desc => <<END, # The path to the directory that contains the GNATS database. END - }, - { - name => 'default_email_domain', - default => 'example.com', - desc => <<'END', + }, + { + name => 'default_email_domain', + default => 'example.com', + desc => <<'END', # Some GNATS users do not have full email addresses, but Bugzilla requires # every user to have an email address. What domain should be appended to # usernames that don't have emails, to make them into email addresses? # (For example, if you leave this at the default, "unknown" would become # "unknown@example.com".) END - }, - { - name => 'component_name', - default => 'General', - desc => <<'END', + }, + { + name => 'component_name', + default => 'General', + desc => <<'END', # GNATS has only "Category" to classify bugs. However, Bugzilla has a # multi-level system of Products that contain Components. When importing # GNATS categories, they become a Product with one Component. What should # the name of that Component be? END - }, - { - name => 'version_regex', - default => '', - desc => <<'END', + }, + { + name => 'version_regex', + default => '', + desc => <<'END', # In GNATS, the "version" field can contain almost anything. However, in # Bugzilla, it's a drop-down, so you don't want too many choices in there. # If you specify a regular expression here, versions will be tested against @@ -115,43 +114,43 @@ END # as the version value for the bug instead of the full version value specified # in GNATS. END - }, - { - name => 'default_originator', - default => 'gnats-admin', - desc => <<'END', + }, + { + name => 'default_originator', + default => 'gnats-admin', + desc => <<'END', # Sometimes, a PR has no valid Originator, so we fall back to the From # header of the email. If the From header also isn't a valid username # (is just a name with spaces in it--we can't convert that to an email # address) then this username (which can either be a GNATS username or an # email address) will be considered to be the Originator of the PR. END - } + } ); sub CONFIG_VARS { - my $self = shift; - my @vars = (GNATS_CONFIG_VARS, $self->SUPER::CONFIG_VARS); - my $field_map = first { $_->{name} eq 'translate_fields' } @vars; - $field_map->{default} = FIELD_MAP; - my $value_map = first { $_->{name} eq 'translate_values' } @vars; - $value_map->{default} = VALUE_MAP; - return @vars; + my $self = shift; + my @vars = (GNATS_CONFIG_VARS, $self->SUPER::CONFIG_VARS); + my $field_map = first { $_->{name} eq 'translate_fields' } @vars; + $field_map->{default} = FIELD_MAP; + my $value_map = first { $_->{name} eq 'translate_values' } @vars; + $value_map->{default} = VALUE_MAP; + return @vars; } # Directories that aren't projects, or that we shouldn't be parsing use constant SKIP_DIRECTORIES => qw( - gnats-adm - gnats-queue - pending + gnats-adm + gnats-queue + pending ); use constant NON_COMMENT_FIELDS => qw( - Audit-Trail - Closed-Date - Confidential - Unformatted - attachments + Audit-Trail + Closed-Date + Confidential + Unformatted + attachments ); # Certain fields can contain things that look like fields in them, @@ -160,20 +159,16 @@ use constant NON_COMMENT_FIELDS => qw( # and wait for the next field to consider that we actually have # a field to parse. use constant END_FIELD_ORDER => qw( - Description - How-To-Repeat - Fix - Release-Note - Audit-Trail - Unformatted + Description + How-To-Repeat + Fix + Release-Note + Audit-Trail + Unformatted ); -use constant CUSTOM_FIELDS => { - cf_type => { - type => FIELD_TYPE_SINGLE_SELECT, - description => 'Type', - }, -}; +use constant CUSTOM_FIELDS => + {cf_type => {type => FIELD_TYPE_SINGLE_SELECT, description => 'Type',},}; use constant FIELD_REGEX => qr/^>(\S+):\s*(.*)$/; @@ -192,24 +187,24 @@ use constant LONG_VERSION_LENGTH => 32; ######### sub before_insert { - my $self = shift; - - # gnats_id isn't a valid User::create field, and we don't need it - # anymore now. - delete $_->{gnats_id} foreach @{ $self->users }; - - # Grab a version out of a bug for each product, so that there is a - # valid "version" argument for Bugzilla::Product->create. - foreach my $product (@{ $self->products }) { - my $bug = first { $_->{product} eq $product->{name} and $_->{version} } - @{ $self->bugs }; - if (defined $bug) { - $product->{version} = $bug->{version}; - } - else { - $product->{version} = 'unspecified'; - } + my $self = shift; + + # gnats_id isn't a valid User::create field, and we don't need it + # anymore now. + delete $_->{gnats_id} foreach @{$self->users}; + + # Grab a version out of a bug for each product, so that there is a + # valid "version" argument for Bugzilla::Product->create. + foreach my $product (@{$self->products}) { + my $bug = first { $_->{product} eq $product->{name} and $_->{version} } + @{$self->bugs}; + if (defined $bug) { + $product->{version} = $bug->{version}; + } + else { + $product->{version} = 'unspecified'; } + } } ######### @@ -217,53 +212,53 @@ sub before_insert { ######### sub _read_users { - my $self = shift; - my $path = $self->config('gnats_path'); - my $file = "$path/gnats-adm/responsible"; - $self->debug("Reading users from $file"); - my $default_domain = $self->config('default_email_domain'); - open(my $users_fh, '<', $file) || die "$file: $!"; - my @users; - foreach my $line (<$users_fh>) { - $line = trim($line); - next if $line =~ /^#/; - my ($id, $name, $email) = split(':', $line, 3); - $email ||= "$id\@$default_domain"; - # We can't call our own translate_value, because that depends on - # the existence of user_map, which doesn't exist until after - # this method. However, we still want to translate any users found. - $email = $self->SUPER::translate_value('user', $email); - push(@users, { realname => $name, login_name => $email, - gnats_id => $id }); - } - close($users_fh); - return \@users; + my $self = shift; + my $path = $self->config('gnats_path'); + my $file = "$path/gnats-adm/responsible"; + $self->debug("Reading users from $file"); + my $default_domain = $self->config('default_email_domain'); + open(my $users_fh, '<', $file) || die "$file: $!"; + my @users; + foreach my $line (<$users_fh>) { + $line = trim($line); + next if $line =~ /^#/; + my ($id, $name, $email) = split(':', $line, 3); + $email ||= "$id\@$default_domain"; + + # We can't call our own translate_value, because that depends on + # the existence of user_map, which doesn't exist until after + # this method. However, we still want to translate any users found. + $email = $self->SUPER::translate_value('user', $email); + push(@users, {realname => $name, login_name => $email, gnats_id => $id}); + } + close($users_fh); + return \@users; } sub user_map { - my $self = shift; - $self->{user_map} ||= { map { $_->{gnats_id} => $_->{login_name} } - @{ $self->users } }; - return $self->{user_map}; + my $self = shift; + $self->{user_map} + ||= {map { $_->{gnats_id} => $_->{login_name} } @{$self->users}}; + return $self->{user_map}; } sub add_user { - my ($self, $id, $email) = @_; - return if defined $self->user_map->{$id}; - $self->user_map->{$id} = $email; - push(@{ $self->users }, { login_name => $email, gnats_id => $id }); + my ($self, $id, $email) = @_; + return if defined $self->user_map->{$id}; + $self->user_map->{$id} = $email; + push(@{$self->users}, {login_name => $email, gnats_id => $id}); } sub user_to_email { - my ($self, $value) = @_; - if (defined $self->user_map->{$value}) { - $value = $self->user_map->{$value}; - } - elsif ($value !~ /@/) { - my $domain = $self->config('default_email_domain'); - $value = "$value\@$domain"; - } - return $value; + my ($self, $value) = @_; + if (defined $self->user_map->{$value}) { + $value = $self->user_map->{$value}; + } + elsif ($value !~ /@/) { + my $domain = $self->config('default_email_domain'); + $value = "$value\@$domain"; + } + return $value; } ############ @@ -271,31 +266,33 @@ sub user_to_email { ############ sub _read_products { - my $self = shift; - my $path = $self->config('gnats_path'); - my $file = "$path/gnats-adm/categories"; - $self->debug("Reading categories from $file"); - - open(my $categories_fh, '<', $file) || die "$file: $!"; - my @products; - foreach my $line (<$categories_fh>) { - $line = trim($line); - next if $line =~ /^#/; - my ($name, $description, $assigned_to, $cc) = split(':', $line, 4); - my %product = ( name => $name, description => $description ); - - my @initial_cc = split(',', $cc); - @initial_cc = @{ $self->translate_value('user', \@initial_cc) }; - $assigned_to = $self->translate_value('user', $assigned_to); - my %component = ( name => $self->config('component_name'), - description => $description, - initialowner => $assigned_to, - initial_cc => \@initial_cc ); - $product{components} = [\%component]; - push(@products, \%product); - } - close($categories_fh); - return \@products; + my $self = shift; + my $path = $self->config('gnats_path'); + my $file = "$path/gnats-adm/categories"; + $self->debug("Reading categories from $file"); + + open(my $categories_fh, '<', $file) || die "$file: $!"; + my @products; + foreach my $line (<$categories_fh>) { + $line = trim($line); + next if $line =~ /^#/; + my ($name, $description, $assigned_to, $cc) = split(':', $line, 4); + my %product = (name => $name, description => $description); + + my @initial_cc = split(',', $cc); + @initial_cc = @{$self->translate_value('user', \@initial_cc)}; + $assigned_to = $self->translate_value('user', $assigned_to); + my %component = ( + name => $self->config('component_name'), + description => $description, + initialowner => $assigned_to, + initial_cc => \@initial_cc + ); + $product{components} = [\%component]; + push(@products, \%product); + } + close($categories_fh); + return \@products; } ################ @@ -303,128 +300,131 @@ sub _read_products { ################ sub _read_bugs { - my $self = shift; - my $path = $self->config('gnats_path'); - my @directories = glob("$path/*"); - my @bugs; - foreach my $directory (@directories) { - next if !-d $directory; - my $name = basename($directory); - next if grep($_ eq $name, SKIP_DIRECTORIES); - push(@bugs, @{ $self->_parse_project($directory) }); - } - @bugs = sort { $a->{Number} <=> $b->{Number} } @bugs; - return \@bugs; + my $self = shift; + my $path = $self->config('gnats_path'); + my @directories = glob("$path/*"); + my @bugs; + foreach my $directory (@directories) { + next if !-d $directory; + my $name = basename($directory); + next if grep($_ eq $name, SKIP_DIRECTORIES); + push(@bugs, @{$self->_parse_project($directory)}); + } + @bugs = sort { $a->{Number} <=> $b->{Number} } @bugs; + return \@bugs; } sub _parse_project { - my ($self, $directory) = @_; - my @files = glob("$directory/*"); - - $self->debug("Reading Project: $directory"); - # Sometimes other files get into gnats directories. - @files = grep { basename($_) =~ /^\d+$/ } @files; - my @bugs; - my $count = 1; - my $total = scalar @files; - print basename($directory) . ":\n"; - foreach my $file (@files) { - push(@bugs, $self->_parse_bug_file($file)); - if (!$self->verbose) { - indicate_progress({ current => $count++, every => 5, - total => $total }); - } + my ($self, $directory) = @_; + my @files = glob("$directory/*"); + + $self->debug("Reading Project: $directory"); + + # Sometimes other files get into gnats directories. + @files = grep { basename($_) =~ /^\d+$/ } @files; + my @bugs; + my $count = 1; + my $total = scalar @files; + print basename($directory) . ":\n"; + foreach my $file (@files) { + push(@bugs, $self->_parse_bug_file($file)); + if (!$self->verbose) { + indicate_progress({current => $count++, every => 5, total => $total}); } - return \@bugs; + } + return \@bugs; } sub _parse_bug_file { - my ($self, $file) = @_; - $self->debug("Reading $file"); - open(my $fh, "<", $file) || die "$file: $!"; - my $email = Email::Simple::FromHandle->new($fh); - my $fields = $self->_get_gnats_field_data($email); - # We parse attachments here instead of during translate_bug, - # because otherwise we'd be taking up huge amounts of memory storing - # all the raw attachment data in memory. - $fields->{attachments} = $self->_parse_attachments($fields); - close($fh); - return $fields; + my ($self, $file) = @_; + $self->debug("Reading $file"); + open(my $fh, "<", $file) || die "$file: $!"; + my $email = Email::Simple::FromHandle->new($fh); + my $fields = $self->_get_gnats_field_data($email); + + # We parse attachments here instead of during translate_bug, + # because otherwise we'd be taking up huge amounts of memory storing + # all the raw attachment data in memory. + $fields->{attachments} = $self->_parse_attachments($fields); + close($fh); + return $fields; } sub _get_gnats_field_data { - my ($self, $email) = @_; - my ($current_field, @value_lines, %fields); - $email->reset_handle(); - my $handle = $email->handle; - foreach my $line (<$handle>) { - # If this line starts a field name - if ($line =~ FIELD_REGEX) { - my ($new_field, $rest_of_line) = ($1, $2); - - # If this is one of the last few PR fields, then make sure - # that we're getting our fields in the right order. - my $new_field_valid = 1; - my $search_for = $current_field || ''; - my $current_field_pos = firstidx { $_ eq $search_for } - END_FIELD_ORDER; - if ($current_field_pos > -1) { - my $new_field_pos = firstidx { $_ eq $new_field } - END_FIELD_ORDER; - # We accept any field, as long as it's later than this one. - $new_field_valid = $new_field_pos > $current_field_pos ? 1 : 0; - } - - if ($new_field_valid) { - if ($current_field) { - $fields{$current_field} = _handle_lines(\@value_lines); - @value_lines = (); - } - $current_field = $new_field; - $line = $rest_of_line; - } + my ($self, $email) = @_; + my ($current_field, @value_lines, %fields); + $email->reset_handle(); + my $handle = $email->handle; + foreach my $line (<$handle>) { + + # If this line starts a field name + if ($line =~ FIELD_REGEX) { + my ($new_field, $rest_of_line) = ($1, $2); + + # If this is one of the last few PR fields, then make sure + # that we're getting our fields in the right order. + my $new_field_valid = 1; + my $search_for = $current_field || ''; + my $current_field_pos = firstidx { $_ eq $search_for } + END_FIELD_ORDER; + if ($current_field_pos > -1) { + my $new_field_pos = firstidx { $_ eq $new_field } + END_FIELD_ORDER; + + # We accept any field, as long as it's later than this one. + $new_field_valid = $new_field_pos > $current_field_pos ? 1 : 0; + } + + if ($new_field_valid) { + if ($current_field) { + $fields{$current_field} = _handle_lines(\@value_lines); + @value_lines = (); } - push(@value_lines, $line) if defined $line; + $current_field = $new_field; + $line = $rest_of_line; + } } - $fields{$current_field} = _handle_lines(\@value_lines); - $fields{cc} = [$email->header('Cc')] if $email->header('Cc'); - - # If the Originator is invalid and we don't have a translation for it, - # use the From header instead. - my $originator = $self->translate_value('reporter', $fields{Originator}, - { check_only => 1 }); - if ($originator !~ Bugzilla->params->{emailregexp}) { - # We use the raw header sometimes, because it looks like "From: user" - # which Email::Address won't parse but we can still use. - my $address = $email->header('From'); - my ($parsed) = Email::Address->parse($address); - if ($parsed) { - $address = $parsed->address; - } - if ($address) { - $self->debug( - "PR $fields{Number} had an Originator that was not a valid" - . " user ($fields{Originator}). Using From ($address)" - . " instead.\n"); - my $address_email = $self->translate_value('reporter', $address, - { check_only => 1 }); - if ($address_email !~ Bugzilla->params->{emailregexp}) { - $self->debug(" From was also invalid, using default_originator.\n"); - $address = $self->config('default_originator'); - } - $fields{Originator} = $address; - } + push(@value_lines, $line) if defined $line; + } + $fields{$current_field} = _handle_lines(\@value_lines); + $fields{cc} = [$email->header('Cc')] if $email->header('Cc'); + + # If the Originator is invalid and we don't have a translation for it, + # use the From header instead. + my $originator + = $self->translate_value('reporter', $fields{Originator}, {check_only => 1}); + if ($originator !~ Bugzilla->params->{emailregexp}) { + + # We use the raw header sometimes, because it looks like "From: user" + # which Email::Address won't parse but we can still use. + my $address = $email->header('From'); + my ($parsed) = Email::Address->parse($address); + if ($parsed) { + $address = $parsed->address; + } + if ($address) { + $self->debug("PR $fields{Number} had an Originator that was not a valid" + . " user ($fields{Originator}). Using From ($address)" + . " instead.\n"); + my $address_email + = $self->translate_value('reporter', $address, {check_only => 1}); + if ($address_email !~ Bugzilla->params->{emailregexp}) { + $self->debug(" From was also invalid, using default_originator.\n"); + $address = $self->config('default_originator'); + } + $fields{Originator} = $address; } + } - $self->debug(\%fields, 3); - return \%fields; + $self->debug(\%fields, 3); + return \%fields; } sub _handle_lines { - my ($lines) = @_; - my $value = join('', @$lines); - $value =~ s/\s+$//; - return $value; + my ($lines) = @_; + my $value = join('', @$lines); + $value =~ s/\s+$//; + return $value; } #################### @@ -432,169 +432,188 @@ sub _handle_lines { #################### sub translate_bug { - my ($self, $fields) = @_; + my ($self, $fields) = @_; - my ($bug, $other_fields) = $self->SUPER::translate_bug($fields); + my ($bug, $other_fields) = $self->SUPER::translate_bug($fields); - $bug->{attachments} = delete $other_fields->{attachments}; + $bug->{attachments} = delete $other_fields->{attachments}; - if (defined $other_fields->{_add_to_comment}) { - $bug->{comment} .= delete $other_fields->{_add_to_comment}; - } + if (defined $other_fields->{_add_to_comment}) { + $bug->{comment} .= delete $other_fields->{_add_to_comment}; + } - my ($changes, $extra_comment) = - $self->_parse_audit_trail($bug, $other_fields->{'Audit-Trail'}); - - my @comments; - foreach my $change (@$changes) { - if (exists $change->{comment}) { - push(@comments, { - thetext => $change->{comment}, - who => $change->{who}, - bug_when => $change->{bug_when} }); - delete $change->{comment}; - } - } - $bug->{history} = $changes; + my ($changes, $extra_comment) + = $self->_parse_audit_trail($bug, $other_fields->{'Audit-Trail'}); - if (trim($extra_comment)) { - push(@comments, { thetext => $extra_comment, who => $bug->{reporter}, - bug_when => $bug->{delta_ts} || $bug->{creation_ts} }); - } - $bug->{comments} = \@comments; - - $bug->{component} = $self->config('component_name'); - if (!$bug->{short_desc}) { - $bug->{short_desc} = NO_SUBJECT; - } - - foreach my $attachment (@{ $bug->{attachments} || [] }) { - $attachment->{submitter} = $bug->{reporter}; - $attachment->{creation_ts} = $bug->{creation_ts}; + my @comments; + foreach my $change (@$changes) { + if (exists $change->{comment}) { + push( + @comments, + { + thetext => $change->{comment}, + who => $change->{who}, + bug_when => $change->{bug_when} + } + ); + delete $change->{comment}; } - - $self->debug($bug, 3); - return $bug; + } + $bug->{history} = $changes; + + if (trim($extra_comment)) { + push( + @comments, + { + thetext => $extra_comment, + who => $bug->{reporter}, + bug_when => $bug->{delta_ts} || $bug->{creation_ts} + } + ); + } + $bug->{comments} = \@comments; + + $bug->{component} = $self->config('component_name'); + if (!$bug->{short_desc}) { + $bug->{short_desc} = NO_SUBJECT; + } + + foreach my $attachment (@{$bug->{attachments} || []}) { + $attachment->{submitter} = $bug->{reporter}; + $attachment->{creation_ts} = $bug->{creation_ts}; + } + + $self->debug($bug, 3); + return $bug; } sub _parse_audit_trail { - my ($self, $bug, $audit_trail) = @_; - return [] if !trim($audit_trail); - $self->debug(" Parsing audit trail...", 2); - - if ($audit_trail !~ /^\S+-Changed-\S+:/ms) { - # This is just a comment from the bug's creator. - $self->debug(" Audit trail is just a comment.", 2); - return ([], $audit_trail); - } - - my (@changes, %current_data, $current_column, $on_why); - my $extra_comment = ''; - my $current_field; - my @all_lines = split("\n", $audit_trail); - foreach my $line (@all_lines) { - # GNATS history looks like: - # Status-Changed-From-To: open->closed - # Status-Changed-By: jack - # Status-Changed-When: Mon May 12 14:46:59 2003 - # Status-Changed-Why: - # This is some comment here about the change. - if ($line =~ /^(\S+)-Changed-(\S+):(.*)/) { - my ($field, $column, $value) = ($1, $2, $3); - my $bz_field = $self->translate_field($field); - # If it's not a field we're importing, we don't care about - # its history. - next if !$bz_field; - # GNATS doesn't track values for description changes, - # unfortunately, and that's the only information we'd be able to - # use in Bugzilla for the audit trail on that field. - next if $bz_field eq 'comment'; - $current_field = $bz_field if !$current_field; - if ($bz_field ne $current_field) { - $self->_store_audit_change( - \@changes, $current_field, \%current_data); - %current_data = (); - $current_field = $bz_field; - } - $value = trim($value); - $self->debug(" $bz_field $column: $value", 3); - if ($column eq 'From-To') { - my ($from, $to) = split('->', $value, 2); - # Sometimes there's just a - instead of a -> between the values. - if (!defined($to)) { - ($from, $to) = split('-', $value, 2); - } - $current_data{added} = $to; - $current_data{removed} = $from; - } - elsif ($column eq 'By') { - my $email = $self->translate_value('user', $value); - # Sometimes we hit users in the audit trail that we haven't - # seen anywhere else. - $current_data{who} = $email; - } - elsif ($column eq 'When') { - $current_data{bug_when} = $self->parse_date($value); - } - if ($column eq 'Why') { - $value = '' if !defined $value; - $current_data{comment} = $value; - $on_why = 1; - } - else { - $on_why = 0; - } - } - elsif ($on_why) { - # "Why" lines are indented four characters. - $line =~ s/^\s{4}//; - $current_data{comment} .= "$line\n"; - } - else { - $self->debug( - "Extra Audit-Trail line on $bug->{product} $bug->{bug_id}:" - . " $line\n", 2); - $extra_comment .= "$line\n"; + my ($self, $bug, $audit_trail) = @_; + return [] if !trim($audit_trail); + $self->debug(" Parsing audit trail...", 2); + + if ($audit_trail !~ /^\S+-Changed-\S+:/ms) { + + # This is just a comment from the bug's creator. + $self->debug(" Audit trail is just a comment.", 2); + return ([], $audit_trail); + } + + my (@changes, %current_data, $current_column, $on_why); + my $extra_comment = ''; + my $current_field; + my @all_lines = split("\n", $audit_trail); + foreach my $line (@all_lines) { + + # GNATS history looks like: + # Status-Changed-From-To: open->closed + # Status-Changed-By: jack + # Status-Changed-When: Mon May 12 14:46:59 2003 + # Status-Changed-Why: + # This is some comment here about the change. + if ($line =~ /^(\S+)-Changed-(\S+):(.*)/) { + my ($field, $column, $value) = ($1, $2, $3); + my $bz_field = $self->translate_field($field); + + # If it's not a field we're importing, we don't care about + # its history. + next if !$bz_field; + + # GNATS doesn't track values for description changes, + # unfortunately, and that's the only information we'd be able to + # use in Bugzilla for the audit trail on that field. + next if $bz_field eq 'comment'; + $current_field = $bz_field if !$current_field; + if ($bz_field ne $current_field) { + $self->_store_audit_change(\@changes, $current_field, \%current_data); + %current_data = (); + $current_field = $bz_field; + } + $value = trim($value); + $self->debug(" $bz_field $column: $value", 3); + if ($column eq 'From-To') { + my ($from, $to) = split('->', $value, 2); + + # Sometimes there's just a - instead of a -> between the values. + if (!defined($to)) { + ($from, $to) = split('-', $value, 2); } + $current_data{added} = $to; + $current_data{removed} = $from; + } + elsif ($column eq 'By') { + my $email = $self->translate_value('user', $value); + + # Sometimes we hit users in the audit trail that we haven't + # seen anywhere else. + $current_data{who} = $email; + } + elsif ($column eq 'When') { + $current_data{bug_when} = $self->parse_date($value); + } + if ($column eq 'Why') { + $value = '' if !defined $value; + $current_data{comment} = $value; + $on_why = 1; + } + else { + $on_why = 0; + } + } + elsif ($on_why) { + + # "Why" lines are indented four characters. + $line =~ s/^\s{4}//; + $current_data{comment} .= "$line\n"; + } + else { + $self->debug( + "Extra Audit-Trail line on $bug->{product} $bug->{bug_id}:" . " $line\n", 2); + $extra_comment .= "$line\n"; } - $self->_store_audit_change(\@changes, $current_field, \%current_data); - return (\@changes, $extra_comment); + } + $self->_store_audit_change(\@changes, $current_field, \%current_data); + return (\@changes, $extra_comment); } sub _store_audit_change { - my ($self, $changes, $old_field, $current_data) = @_; - - $current_data->{field} = $old_field; - $current_data->{removed} = - $self->translate_value($old_field, $current_data->{removed}); - $current_data->{added} = - $self->translate_value($old_field, $current_data->{added}); - push(@$changes, { %$current_data }); + my ($self, $changes, $old_field, $current_data) = @_; + + $current_data->{field} = $old_field; + $current_data->{removed} + = $self->translate_value($old_field, $current_data->{removed}); + $current_data->{added} + = $self->translate_value($old_field, $current_data->{added}); + push(@$changes, {%$current_data}); } sub _parse_attachments { - my ($self, $fields) = @_; - my $unformatted = delete $fields->{'Unformatted'}; - my $gnats_boundary = GNATS_BOUNDARY; - # A sanity checker to make sure that we're parsing attachments right. - my $num_attachments = 0; - $num_attachments++ while ($unformatted =~ /\Q$gnats_boundary\E/g); - # Sometimes there's a GNATS_BOUNDARY that is on the same line as other data. - $unformatted =~ s/(\S\s*)\Q$gnats_boundary\E$/$1\n$gnats_boundary/mg; - # Often the "Unformatted" section starts with stuff before - # ----gnatsweb-attachment---- that isn't necessary. - $unformatted =~ s/^\s*From:.+?Reply-to:[^\n]+//s; - $unformatted = trim($unformatted); - return [] if !$unformatted; - $self->debug('Reading attachments...', 2); - my $boundary = generate_random_password(48); - $unformatted =~ s/\Q$gnats_boundary\E/--$boundary/g; - # Sometimes the whole Unformatted section is indented by exactly - # one space, and needs to be fixed. - if ($unformatted =~ /--\Q$boundary\E\n /) { - $unformatted =~ s/^ //mg; - } - $unformatted = <<END; + my ($self, $fields) = @_; + my $unformatted = delete $fields->{'Unformatted'}; + my $gnats_boundary = GNATS_BOUNDARY; + + # A sanity checker to make sure that we're parsing attachments right. + my $num_attachments = 0; + $num_attachments++ while ($unformatted =~ /\Q$gnats_boundary\E/g); + + # Sometimes there's a GNATS_BOUNDARY that is on the same line as other data. + $unformatted =~ s/(\S\s*)\Q$gnats_boundary\E$/$1\n$gnats_boundary/mg; + + # Often the "Unformatted" section starts with stuff before + # ----gnatsweb-attachment---- that isn't necessary. + $unformatted =~ s/^\s*From:.+?Reply-to:[^\n]+//s; + $unformatted = trim($unformatted); + return [] if !$unformatted; + $self->debug('Reading attachments...', 2); + my $boundary = generate_random_password(48); + $unformatted =~ s/\Q$gnats_boundary\E/--$boundary/g; + + # Sometimes the whole Unformatted section is indented by exactly + # one space, and needs to be fixed. + if ($unformatted =~ /--\Q$boundary\E\n /) { + $unformatted =~ s/^ //mg; + } + $unformatted = <<END; From: nobody MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="$boundary" @@ -607,96 +626,103 @@ Content-Transfer-Encoding: 7bit $unformatted --$boundary-- END - my $email = new Email::MIME(\$unformatted); - my @parts = $email->parts; - # Remove the fake body. - my $part1 = shift @parts; - if ($part1->body) { - $self->debug(" Additional Unformatted data found on " - . $fields->{Category} . " bug " . $fields->{Number}); - $self->debug($part1->body, 3); - $fields->{_add_comment} .= "\n\nUnformatted:\n" . $part1->body; - } + my $email = new Email::MIME(\$unformatted); + my @parts = $email->parts; + + # Remove the fake body. + my $part1 = shift @parts; + if ($part1->body) { + $self->debug(" Additional Unformatted data found on " + . $fields->{Category} . " bug " + . $fields->{Number}); + $self->debug($part1->body, 3); + $fields->{_add_comment} .= "\n\nUnformatted:\n" . $part1->body; + } + + my @attachments; + foreach my $part (@parts) { + $self->debug(' Parsing attachment: ' . $part->filename); + my $temp_fh = IO::File->new_tmpfile or die("Can't create tempfile: $!"); + $temp_fh->binmode; + print $temp_fh $part->body; + my $content_type = $part->content_type; + $content_type =~ s/; name=.+$//; + my $attachment = { + filename => $part->filename, + description => $part->filename, + mimetype => $content_type, + data => $temp_fh + }; + $self->debug($attachment, 3); + push(@attachments, $attachment); + } + + if (scalar(@attachments) ne $num_attachments) { + warn "WARNING: Expected $num_attachments attachments but got " + . scalar(@attachments) . "\n"; + $self->debug($unformatted, 3); + } + return \@attachments; +} - my @attachments; - foreach my $part (@parts) { - $self->debug(' Parsing attachment: ' . $part->filename); - my $temp_fh = IO::File->new_tmpfile or die ("Can't create tempfile: $!"); - $temp_fh->binmode; - print $temp_fh $part->body; - my $content_type = $part->content_type; - $content_type =~ s/; name=.+$//; - my $attachment = { filename => $part->filename, - description => $part->filename, - mimetype => $content_type, - data => $temp_fh }; - $self->debug($attachment, 3); - push(@attachments, $attachment); +sub translate_value { + my $self = shift; + my ($field, $value, $options) = @_; + my $original_value = $value; + $options ||= {}; + + if (!ref($value) and grep($_ eq $field, $self->USER_FIELDS)) { + if ($value =~ /(\S+\@\S+)/) { + $value = $1; + $value =~ s/^<//; + $value =~ s/>$//; } - - if (scalar(@attachments) ne $num_attachments) { - warn "WARNING: Expected $num_attachments attachments but got " - . scalar(@attachments) . "\n" ; - $self->debug($unformatted, 3); + else { + # Sometimes names have extra stuff on the end like "(Somebody's Name)" + $value =~ s/\s+\(.+\)$//; + + # Sometimes user fields look like "(user)" instead of just "user". + $value =~ s/^\((.+)\)$/$1/; + $value = trim($value); } - return \@attachments; -} + } -sub translate_value { - my $self = shift; - my ($field, $value, $options) = @_; - my $original_value = $value; - $options ||= {}; - - if (!ref($value) and grep($_ eq $field, $self->USER_FIELDS)) { - if ($value =~ /(\S+\@\S+)/) { - $value = $1; - $value =~ s/^<//; - $value =~ s/>$//; - } - else { - # Sometimes names have extra stuff on the end like "(Somebody's Name)" - $value =~ s/\s+\(.+\)$//; - # Sometimes user fields look like "(user)" instead of just "user". - $value =~ s/^\((.+)\)$/$1/; - $value = trim($value); - } + if ($field eq 'version' and $value ne '') { + my $version_re = $self->config('version_regex'); + if ($version_re and $value =~ $version_re) { + $value = $1; } - if ($field eq 'version' and $value ne '') { - my $version_re = $self->config('version_regex'); - if ($version_re and $value =~ $version_re) { - $value = $1; - } - # In the GNATS that I tested this with, there were many extremely long - # values for "version" that caused some import problems (they were - # longer than the max allowed version value). So if the version value - # is longer than 32 characters, pull out the first thing that looks - # like a version number. - elsif (length($value) > LONG_VERSION_LENGTH) { - $value =~ s/^.+?\b(\d[\w\.]+)\b.+$/$1/; - } + # In the GNATS that I tested this with, there were many extremely long + # values for "version" that caused some import problems (they were + # longer than the max allowed version value). So if the version value + # is longer than 32 characters, pull out the first thing that looks + # like a version number. + elsif (length($value) > LONG_VERSION_LENGTH) { + $value =~ s/^.+?\b(\d[\w\.]+)\b.+$/$1/; } - - my @args = @_; + } + + my @args = @_; + $args[1] = $value; + + $value = $self->SUPER::translate_value(@args); + return $value if ref $value; + + if (grep($_ eq $field, $self->USER_FIELDS)) { + my $from_value = $value; + $value = $self->user_to_email($value); $args[1] = $value; - + + # If we got something new from user_to_email, do any necessary + # translation of it. $value = $self->SUPER::translate_value(@args); - return $value if ref $value; - - if (grep($_ eq $field, $self->USER_FIELDS)) { - my $from_value = $value; - $value = $self->user_to_email($value); - $args[1] = $value; - # If we got something new from user_to_email, do any necessary - # translation of it. - $value = $self->SUPER::translate_value(@args); - if (!$options->{check_only}) { - $self->add_user($from_value, $value); - } + if (!$options->{check_only}) { + $self->add_user($from_value, $value); } - - return $value; + } + + return $value; } 1; |