X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=1fed9520f13c9cea7616a9a5a61dad02f0947890;hb=6ea99c2561e6c87310194097e88ddf1cf089c868;hp=c808aeea4931f3d0981cd38ffe3bac0f3430e83b;hpb=548a47b0ec1040320e56f17cfac71f716785cb95;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index c808aeea4..1fed9520f 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,7 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $noexport_hack $conf +use vars qw( @ISA $DEBUG $me $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst @@ -32,6 +32,9 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); +$DEBUG = 0; +$me = '[FS::svc_acct]'; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { $conf = new FS::Conf; @@ -59,6 +62,9 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; } else { $welcome_template = ''; + $welcome_from = ''; + $welcome_subject = ''; + $welcome_mimetype = ''; } $smtpmachine = $conf->config('smtpmachine'); $radius_password = $conf->config('radius-password') || 'Password'; @@ -183,7 +189,7 @@ sqlradius export only) (TODOC: L and L) -(TODOC: new exports! $noexport_hack) +(TODOC: new exports!) =cut @@ -263,7 +269,11 @@ sub insert { # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); #} - my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #silly kludge to avoid uninitialized value errors + my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) + ? $exports->{$part_export->exporttype}{'nodomain'} + : ''; if ( $nodomain =~ /^Y/i ) { $conflict_user_svcpart{$_} = $part_export->exportnum foreach @svcparts; @@ -359,13 +369,13 @@ sub insert { 'svcnum' => $self->svcnum, 'job' => 'FS::svc_acct::send_email' }; - warn "attempting to queue email to $to"; my $error = $wqueue->insert( 'to' => $to, 'from' => $welcome_from, 'subject' => $welcome_subject, 'mimetype' => $welcome_mimetype, 'body' => $welcome_template->fill_in( HASH => { + 'custnum' => $self->custnum, 'username' => $self->username, 'password' => $self->_password, 'first' => $cust_main->first, @@ -375,14 +385,14 @@ sub insert { ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queuing welcome email: $error"; + return "error queuing welcome email: $error"; } foreach my $jobnum ( @jobnums ) { my $error = $wqueue->depend_insert($jobnum); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queuing welcome email job dependancy: $error"; + return "error queuing welcome email job dependancy: $error"; } } @@ -403,7 +413,7 @@ error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. -(TODOC: new exports! $noexport_hack) +(TODOC: new exports!) =cut @@ -496,6 +506,7 @@ sqlradius export only) sub replace { my ( $new, $old ) = ( shift, shift ); my $error; + warn "$me replacing $old with $new\n" if $DEBUG; return "Username in use" if $old->username ne $new->username && @@ -522,7 +533,13 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + # redundant, but so $new->usergroup gets set + $error = $new->check; + return $error if $error; + $old->usergroup( [ $old->radius_groups ] ); + warn "old groups: ". join(' ',@{$old->usergroup}). "\n" if $DEBUG; + warn "new groups: ". join(' ',@{$new->usergroup}). "\n" if $DEBUG; if ( $new->usergroup ) { #(sorta) false laziness with FS::part_export::sqlradius::_export_replace my @newgroups = @{$new->usergroup}; @@ -586,6 +603,8 @@ error, returns the error, otherwise returns false. Called by the suspend method of FS::cust_pkg (see L). +Calls any export-specific suspend hooks. + =cut sub suspend { @@ -610,6 +629,8 @@ an error, returns the error, otherwise returns false. Called by the unsuspend method of FS::cust_pkg (see L). +Calls any export-specific unsuspend hooks. + =cut sub unsuspend { @@ -656,7 +677,8 @@ sub check { } my $error = $self->ut_numbern('svcnum') - || $self->ut_number('domsvc') + #|| $self->ut_number('domsvc') + || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' ) || $self->ut_textn('sec_phrase') ; return $error if $error; @@ -765,12 +787,14 @@ sub check { $recref->{quota} = $1; unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { - unless ( $recref->{slipip} eq '0e0' ) { + if ( $recref->{slipip} eq '' ) { + $recref->{slipip} = ''; + } elsif ( $recref->{slipip} eq '0e0' ) { + $recref->{slipip} = '0e0'; + } else { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ or return "Illegal slipip: ". $self->slipip; $recref->{slipip} = $1; - } else { - $recref->{slipip} = '0e0'; } } @@ -904,6 +928,8 @@ sub svc_domain { Returns the FS::cust_svc record for this account (see L). +=cut + sub cust_svc { my $self = shift; qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); @@ -1004,36 +1030,28 @@ sub radius_groups { =item send_email +This is the FS::svc_acct job-queue-able version. It still uses +FS::Misc::send_email under-the-hood. + =cut sub send_email { my %opt = @_; - use Date::Format; - use Mail::Internet 1.44; - use Mail::Header; + eval "use FS::Misc qw(send_email)"; + die $@ if $@; $opt{mimetype} ||= 'text/plain'; $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - $ENV{MAILADDRESS} = $opt{from}; - my $header = new Mail::Header ( [ - "From: $opt{from}", - "To: $opt{to}", - "Sender: $opt{from}", - "Reply-To: $opt{from}", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: $opt{subject}", - "Content-Type: $opt{mimetype}", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ map "$_\n", split("\n", $opt{body}) ], + my $error = send_email( + 'from' => $opt{from}, + 'to' => $opt{to}, + 'subject' => $opt{subject}, + 'content-type' => $opt{mimetype}, + 'body' => [ map "$_\n", split("\n", $opt{body}) ], ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; + die $error if $error; } =item check_and_rebuild_fuzzyfiles