source: utils/create_nicksfile.pl @ e6648bf

Last change on this file since e6648bf was b7d3cc34, checked in by Wilmer van der Gaast <wilmer@…>, at 2005-11-06T18:23:18Z

Initial repository (0.99 release tree)

  • Property mode set to 100755
File size: 5.5 KB
Line 
1#!/usr/bin/perl
2use strict;
3use Getopt::Long;
4
5
6my $conn                = undef;
7my %readline_funcs      = ( 'licq' => \&import_readline_licq );
8my %open_funcs          = ( 'licq' => \&import_open_licq );
9my %close_funcs         = ( 'licq' => \&import_close_licq );
10my $funcname            = undef;
11my $dirname             = undef;
12my $filename            = undef;
13my $imported            = 0;
14my $not_imported        = 0;
15my $debug               = 0;
16
17main();
18exit(0);
19
20
21sub main {
22        my ($server,$port,$nick,$pass,$func,$dir,$file,$outfile);
23        my $dirfile;
24        if (($dirfile=pop @ARGV) =~ /^\-/ || !$dirfile) {
25                tell_usage();
26                exit(0);
27        }
28        if ($dirfile =~ m|/|) {
29                $dirfile =~ m|^(.*)(/.+)$|;
30                $dir=$1;
31                $file=$2;
32        } else {
33                $dir=undef;
34                $file = $dirfile;
35        }
36        GetOptions(
37                'from=s',  => \$func,
38                'of=s',  => \$outfile,
39                'debug',  => \$debug
40        );
41        if (!import_start($func,$dir,$file,$outfile,$debug)) {
42                tell_usage();
43        }
44}
45
46sub tell_usage {
47        print "Usage: create_nicksfile.pl [--from=FROM] [--of=OUTPUTFILE] [--debug] FILENAME\n";
48        print "       FROM defines which application we import from.\n",
49        print "       Note that currently the only valid value for FROM is licq.\n";
50        print "       For further information, you might want to do perldoc create_nicksfile.pl\n";
51}
52
53sub import_start {
54        $funcname          = (shift) || 'licq';
55        $dirname        = shift;
56        $filename       = shift;
57        my $outfile        = shift || 'bitlbee.nicks';
58        $debug          = shift;
59        my ($alias,$protocol,$name,$found);
60        open(OUT,'>'.$outfile) || die "unable to open $outfile";
61        if (defined $open_funcs{$funcname}) {
62                if (&{$open_funcs{$funcname}}($dirname,$filename)) {
63                        do {
64                                ($alias,$protocol,$name,$found)=&{$readline_funcs{$funcname}}();
65                                print OUT "$alias $protocol $name\n" if $found;
66                        } while ($found);
67                } else {
68                        import_err('Unable to open '.$filename);
69                        return 0;
70                }
71        } else {
72                import_err($funcname.' is no defined import function.');
73                return 0;
74        }
75        close OUT;
76        &{$close_funcs{$funcname}}();
77        return 1;
78}
79
80sub import_err {
81        my $msg=shift;
82        print "\nError: $msg\n";
83}
84
85sub import_open_licq {
86        my ($dir,$name)=@_;
87        return open(IN,'<'.$dir.'/users.conf');
88}
89sub import_close_licq {
90        close IN;
91}
92sub import_readline_licq {
93        my ($uin,$alias);
94        my $line;
95GETLINE:
96        $line=<IN>;
97        if ($line) {
98                while ($line && $line !~ /^User\d+/) {
99                        $line=<IN>;
100                }
101                if ($line) {
102                        if ($line =~ /^User\d+\s*=\s*(\d+)(\.Licq)?$/) { # getting UIN
103                                $uin=$1;
104                                open(ALIAS,'<'.$dirname.'/users/'.$uin.'.Licq') ||
105                                open(ALIAS,'<'.$dirname.'/users/'.$uin.'.uin') || do {
106                                        warn "unable to open userfile for $uin";
107                                        return (undef,undef,0);
108                                };
109                                while (<ALIAS>) {
110                                        if (/^Alias\s*=\s*(.*)$/) {
111                                                $alias=$1;
112                                                $alias =~ s/\s+/_/g;
113                                                last;
114                                        }
115                                }
116                                close ALIAS;
117                                $imported++;
118                                return ($uin,3,$alias,1);
119                        } else {
120                                warn('Unknown line format: '.$line);
121                                $not_imported++;
122                                goto GETLINE; #### grrrr, sometimes there are negative uins in licq files...
123                        }
124                } else {
125                        return (undef,undef,0);
126                }
127        } else {
128                return undef;
129        }
130}
131
132__END__
133
134=head1 NAME
135
136create_nicksfile.pl - Create a valid bitlbee .nicks file
137
138=head1 SYNOPSIS
139
140create_nicksfile.pl [--from=FROM] [--of=OUTPUTFILE] [--debug] FILENAME
141
142        FROM defines which application we import from.
143        Note that currently the only valid value for FROM
144        is licq.
145
146        If of is missing, we write to bitlbee.nicks.
147
148=head1 DESCRIPTION
149
150We run thru the
151files where the contacts reside and create
152a bitlbee .nicks-file from them.
153
154=head1 DEPENDENCIES
155
156On the perlside, we need Getopt::Long.
157
158=head1 CAVEATS
159
160=head1 TODO
161
162&import_readline_... should take a filehandle as argument.
163
164Add more import functions. If you are interested,
165to do so, you need to write the following functions:
166
167=over
168
169=item *
170
171import_open_<WHATEVER>(DIR,FILENAME)
172
173=item *
174
175import_close_<WHATEVER>()
176
177=item *
178
179import_readline_<WHATEVER>()
180
181=back
182
183and add them to the hashes
184
185=over
186
187=item *
188
189%readline_funcs
190
191=item *
192
193%open_funcs
194
195=item *
196
197%close_funcs
198
199=back
200
201at the top of this script.
202
203
204=head1 AUTHORS
205
206Christian Friedl <vijeno@chello.at>
207
208Updated for the new Licq list firmat by Hugo Buddelmeijer <kmail@hugo.doemaarwat.nl>
209
210=cut
Note: See TracBrowser for help on using the repository browser.