Convert Opera Contacts in .adr format to csv

[walto]

Here is a little script I wrote, but I won't sing it note for note (even if it is intended for Opera). Opera exports its contacts to an .adr file. To import it to other mail clients I had to convert it to a CSV list.

The script extracts all fields that are marked as contacts and ignores folders and Trash.

Here is the code:

#!/usr/bin/perl
#
#
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;

my $input     = '';
my $output    = 'addresses.csv';
my $delimiter = "##";

GetOptions(
    'i|input=s'     => \$input,
    'o|output=s'    => \$output,
    'd|delimiter=s' => \$delimiter
);

pod2usage( -message => "Missing input file name :\n", -verbose => 1 )
  if ( $input eq '' );

my ( @table, @cols );
my %cols;

open( my $in, "<", $input ) or die "Can not open $input ", $!, " \n";
local $/;
my $content = <$in>;
close $in;

open( my $out, '>', $output ) or die "Can not open $output", $!, "\n";

if ( $content =~ /\t/ ) {
    $content =~ s/\t//g;
}

my @chunks = split '#', $content;

for my $line (@chunks) {
    my %data;
    if ( $line =~ /CONTACT/ ) {
        $line =~ s/CONTACT//;
        if ( $line =~ /\n/ ) {
            my @line = split /\n/, $line;
            for my $line (@line) {
                chomp $line;
                if ( $line =~ /(.+?)=.+/ ) {
                    unless ( $cols{$1} and $cols{$1} == 1 ) {
                        $cols{ ucfirst lc $1 } = 1;
                        push @cols, ucfirst lc $1;
                    }
                    my @fields = split '=', $line;
                    if ( $fields[1] ) {
                        $data{ ucfirst lc $fields[0] } = $fields[1];
                    }
                }
            }
        }
    }
    push @table, \%data if (%data);
}

print $out join $delimiter, @cols, "\n";

for my $row (@table) {
    my @rows;
    for (@cols) {
        if ( $$row{$_} ) {
            push @rows, $$row{$_};
        }
    }
    print $out join $delimiter, @rows, "\n";
}

close $out;

__END__

=head1 NAME

operaadr2csv.pl - Converts Opera .adr files to csv file

=head1 SYNOPSIS

operaadr2csv.pl -i [inputfile] [options]

 Options:
   -i | input
   -d | -delimiter           
   -o | -output            

=head1 OPTIONS

=over 8

=item -i

Sets the name of the input file. This option is mandatory.

=item -d

Sets a delimiter. The default delimiter is ##    

=item -o

Sets a name for the outputfile. The default name for the output file i
+s addresses.csv

=back

=head1 DESCRIPTION

This program will convert contacts from opera browser .adr fileformat 
+to a csv list. The delimiter for the creation of the csv file can be 
+changed.

=cut

[Tux]

Opera and CSV is one post, that should trigger my attention :)

Nice try, but there are a few problems in this script.

• ## delimited data is not really CSV, is it?
• split works with regex's, not with strings (with " " as exception)
• There is no encoding specified
• The cols are stored multiple times

The first line of your output would be:

Id##Name##Created##Active##Mail##Icon##Id##Name##Created##Mail##Icon##
+Id##Name##Created##Mail##Icon##Id##Name##Created##Mail##Icon##Id##Nam
+e##Created##Mail##Icon##Id##Name##Created##Mail##Icon##Id##Name##Crea
+ted##Mail##Icon##Id##Name##Created##Mail##Icon##Id##Name##Created##Ma
+il##Icon##

Where my corrected (and much shorter) version will generate:

Id,Name,Created,Active,Mail,Icon

As I do not use Opera's mail, my address books are too small to see any problematic data, but what would happen is names or addresses contain diacriticals (accented letters) or the chosen delimiter character(s)? If the .adr files are stored in UTF-8, the "<" in open should be "<:encoding(utf-8)". Here's a cleaned up version that uses Text::CSV_XS for output generation.

#!/pro/bin/perl

use strict;
use warnings;
use autodie;

use Getopt::Long;
use Text::CSV_XS;
use Pod::Usage;

my $input     = "";
my $output    = "addresses.csv";

GetOptions (
    "i|input=s"     => \$input,
    "o|output=s"    => \$output,
    );

$input or pod2usage (-message => "Missing input file name :\n", -verbo
+se => 1);

open my $in, "<", $input  or die "Can not open $input ", $!, "\n";
my @chunks = split m/^#/m, do { local $/; <$in> };
close $in;

my (@table, %cols, @cols);
foreach my $chunk (@chunks) {
    $chunk =~ s/CONTACT// && $chunk =~ m/\n/ or next;

    my %data;
    foreach my $line (split m/\n+/ => $chunk) {
        $line =~ m/^\s*(.+?)\s*=\s*(.+)/ or next;

        my ($col, $val) = (ucfirst lc $1, $2);
        $cols{$col}++ or push @cols, $col;

        $data{$col} = $val;
        }
    keys %data and push @table, \%data;
    }

my $csv = Text::CSV_XS->new ({ binary => 1, auto_diag => 1, eol => "\n
+" });
open my $out, ">", $output or die "Can not open $output", $!, "\n";
$csv->print ($out, \@cols);
$csv->print ($out, [ @{$_}{@cols} ]) for @table;
close $out;

__END__

=head1 NAME

operaadr2csv.pl - Converts Opera .adr files to csv file

=head1 SYNOPSIS

operaadr2csv.pl -i [inputfile] [options]

 Options:
   -i | input
   -o | -output

=head1 DESCRIPTION

This program will convert contacts from opera browser .adr fileformat 
+to
a csv list.

=head1 OPTIONS

=over 4

=item -i

Sets the name of the input file. This option is mandatory.

=item -o

Sets a name for the outputfile. The default name for the output file i
+s
addresses.csv

=back

=cut

[walto]

Looks good, works better. Great !
Thanks

[jwkrahn]

if ( $content =~ /\t/ ) {
    $content =~ s/\t//g;
}

Why are you testing for /\t/ first?    If the substitution operator doesn't find a "\t" it will not remove anything so the first test is superfluous.    And would probably would be better to use the tr/// operator anyway:

$content =~ tr/\t//d;





    if ( $line =~ /CONTACT/ ) {
        $line =~ s/CONTACT//;

Why are you testing for /CONTACT/ first?    Just use the substitution operator in the test:

    if ( $line =~ s/CONTACT// ) {





                if ( $line =~ /(.+?)=.+/ ) {
                    unless ( $cols{$1} and $cols{$1} == 1 ) {
                        $cols{ ucfirst lc $1 } = 1;
                        push @cols, ucfirst lc $1;
                    }

You are testing for an unmodified $1 but you are storing a modified $1 in the hash so how is the test supposed to work correctly?    And why the two tests on $cols{$1} when the value can only ever be either 1 or undef?





        if ( $$row{$_} ) {
            push @rows, $$row{$_};
        }

$$row{$_} is usually written as $row->{$_}.