1# -*- indent-tabs-mode: nil; -*- 2# vim:ft=perl:et:sw=4 3 4# Sympa - SYsteme de Multi-Postage Automatique 5# 6# Copyright 2019 The Sympa Community. See the AUTHORS.md file at 7# the top-level directory of this distribution and at 8# <https://github.com/sympa-community/sympa.git>. 9# 10# This program is free software; you can redistribute it and/or modify 11# it under the terms of the GNU General Public License as published by 12# the Free Software Foundation; either version 2 of the License, or 13# (at your option) any later version. 14# 15# This program is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18# GNU General Public License for more details. 19# 20# You should have received a copy of the GNU General Public License 21# along with this program. If not, see <http://www.gnu.org/licenses/>. 22 23package Sympa::DataSource::RemoteDump; 24 25use strict; 26use warnings; 27 28use Sympa::Log; 29use Sympa::Regexps; 30 31use base qw(Sympa::DataSource::RemoteFile); # Derived class 32 33my $log = Sympa::Log->instance; 34 35use constant required_modules => [qw(LWP::Protocol::https)]; 36 37# Old name: (part of) Sympa::Fetch::get_https(), Sympa::List::_get_https(). 38sub _open { 39 my $self = shift; 40 41 unless ($self->{url}) { 42 my $host_re = Sympa::Regexps::host(); 43 my $host = $self->{host}; 44 return undef unless $host and $host =~ /\A$host_re\z/; 45 46 my $port = $self->{port} || '443'; 47 my $path = $self->{path}; 48 $path = '' unless defined $path; 49 $path = "/$path" unless 0 == index $path, '/'; 50 51 $self->{url} = sprintf 'https://%s:%s%s', $host, $port, $path; 52 } 53 54 my $fh = $self->SUPER::_open(use_cert => 1); 55 return $fh; 56} 57 58sub _next { 59 my $self = shift; 60 61 my $fh = $self->__dsh; 62 63 my %entry; 64 while (my $line = <$fh>) { 65 $line =~ s/\s+\z//; 66 67 if ($line eq '') { 68 last if defined $entry{email} and length $entry{email}; 69 %entry = (); 70 } elsif ($line =~ /\A\s*(\w+)(?:\s+(.*))?\z/) { 71 $entry{$1} = $2; 72 } else { 73 $log->syslog( 74 'err', 75 '%s: Illegal line %.128s. Source file probably corrupted. Aborting', 76 $self, 77 $line 78 ); 79 return; 80 } 81 } 82 83 return [@entry{qw(email gecos)}] 84 if defined $entry{email} and length $entry{email}; 85 return; 86} 87 881; 89__END__ 90 91=encoding utf-8 92 93=head1 NAME 94 95Sympa::DataSource::RemoteDump - 96Data source based on a user dump at remote host 97 98=head1 DESCRIPTION 99 100Include a remote sympa list as subscribers. 101 102=head1 SEE ALSO 103 104L<Sympa::DataSource>. 105 106=head1 HISTORY 107 108L<Sympa::DataSource::RemoteDump> appeared on Sympa 6.2.45b. 109 110=cut 111