App-WHMCSUtils
view release on metacpan or search on metacpan
lib/App/WHMCSUtils.pm view on Meta::CPAN
schema => 'str*',
default => 'localhost',
},
db_port => {
schema => 'net::port*',
default => '3306',
},
db_user => {
schema => 'str*',
},
db_pass => {
schema => 'str*',
},
);
our %args_whmcs_credential = (
url => {
schema => 'url*',
req => 1,
description => <<'_',
It should be without `/admin` part, e.g.:
https://client.mycompany.com/
_
},
admin_username => {
schema => 'str*',
req => 1,
},
admin_password => {
schema => 'str*',
req => 1,
},
mech_user_agent => {
schema => 'str*',
},
);
sub _connect_db {
require DBIx::Connect::MySQL;
my %args = @_;
my $dsn = join(
"",
"DBI:mysql:database=$args{db_name}",
(defined($args{db_host}) ? ";host=$args{db_host}" : ""),
(defined($args{db_port}) ? ";port=$args{db_port}" : ""),
);
DBIx::Connect::MySQL->connect(
$dsn, $args{db_user}, $args{db_pass},
{RaiseError => 1},
);
}
$SPEC{restore_whmcs_client} = {
v => 1.1,
summary => "Restore a missing client from SQL database backup",
args => {
sql_backup_file => {
schema => 'filename*',
description => <<'_',
Can accept either `.sql` or `.sql.gz`.
Will be converted first to a directory where the SQL file will be extracted to
separate files on a per-table basis.
_
},
sql_backup_dir => {
summary => 'Directory containing per-table SQL files',
schema => 'dirname*',
description => <<'_',
_
},
client_email => {
schema => 'str*',
},
client_id => {
schema => 'posint*',
},
restore_invoices => {
schema => 'bool*',
default => 1,
},
restore_hostings => {
schema => 'bool*',
default => 1,
},
restore_domains => {
schema => 'bool*',
default => 1,
},
},
args_rels => {
'req_one&' => [
['sql_backup_file', 'sql_backup_dir'],
['client_email', 'client_id'],
],
},
deps => {
prog => "mysql-sql-dump-extract-tables",
},
features => {
dry_run => 1,
},
};
sub restore_whmcs_client {
my %args = @_;
local $CWD;
my $sql_backup_dir;
my $decompress = 0;
if ($args{sql_backup_file}) {
return [404, "No such file: $args{sql_backup_file}"]
unless -f $args{sql_backup_file};
my $pt = path($args{sql_backup_file});
my $basename = $pt->basename;
if ($basename =~ /(.+)\.sql\z/i) {
$sql_backup_dir = $1;
} elsif ($basename =~ /(.+)\.sql\.gz\z/i) {
$sql_backup_dir = $1;
$decompress = 1;
} else {
return [412, "SQL backup file should be named *.sql or *.sql.gz: ".
"$args{sql_backup_file}"];
}
if (-d $sql_backup_dir) {
log_info "SQL backup dir '$sql_backup_dir' already exists, ".
"skipped extracting";
} else {
mkdir $sql_backup_dir, 0755
or return [500, "Can't mkdir '$sql_backup_dir': $!"];
$CWD = $sql_backup_dir;
my @cmd;
if ($decompress) {
push @cmd, "zcat", $pt->absolute->stringify, \"|";
} else {
push @cmd, "cat", $pt->absolute->stringify, \"|";
}
push @cmd, "mysql-sql-dump-extract-tables",
"--include-table-pattern", '^(tblclients|tblinvoices|tblinvoiceitems|tblorders)$';
system({shell=>1, die=>1, log=>1}, @cmd);
}
} elsif ($args{sql_backup_dir}) {
$sql_backup_dir = $args{sql_backup_dir};
return [404, "No such dir: $sql_backup_dir"]
unless -d $sql_backup_dir;
$CWD = $sql_backup_dir;
}
my @sql;
my $clientid = $args{client_id};
FIND_CLIENT:
{
open my $fh, "<", "tblclients"
or return [500, "Can't open $sql_backup_dir/tblclients: $!"];
my $clientemail;
$clientemail = lc $args{client_email} if defined $args{client_email};
while (<$fh>) {
next unless /^INSERT INTO `tblclients` \(`id`, `firstname`, `lastname`, `companyname`, `email`, [^)]+\) VALUES \((\d+),'(.*?)','(.*?)','(.*?)','(.*?)',/;
my ($rid, $rfirstname, $rlastname, $rcompanyname, $remail) = ($1, $2, $3, $4, $5);
if (defined $clientid) {
# find by ID
if ($rid == $clientid) {
$clientemail = $remail;
push @sql, $_;
log_info "Found client ID=%s in backup", $clientid;
last FIND_CLIENT;
}
} else {
# find by email
if (lc $remail eq $clientemail) {
$clientid = $rid;
push @sql, $_;
log_info "Found client email=%s in backup: ID=%s", $clientemail, $clientid;
last FIND_CLIENT;
}
}
}
return [404, "Couldn't find client email=$clientemail in database backup, please check the email or try another backup"];
}
my @invoiceids;
FIND_INVOICES:
{
last unless $args{restore_invoices};
open my $fh, "<", "tblinvoices"
or return [500, "Can't open $sql_backup_dir/tblinvoices: $!"];
while (<$fh>) {
next unless /^INSERT INTO `tblinvoices` \(`id`, `userid`, [^)]+\) VALUES \((\d+),(\d+),/;
my ($rid, $ruserid) = ($1, $2);
if ($ruserid == $clientid) {
push @invoiceids, $rid;
push @sql, $_;
log_info "Found client invoice in backup: ID=%s", $rid;
}
}
log_info "Number of invoices found for client in backup: %d", ~~@invoiceids if @invoiceids;
}
FIND_INVOICEITEMS:
{
last unless @invoiceids;
open my $fh, "<", "tblinvoiceitems"
or return [500, "Can't open $sql_backup_dir/tblinvoiceitems: $!"];
while (<$fh>) {
next unless /^INSERT INTO `tblinvoiceitems` \(`id`, `invoiceid`, `userid`, [^)]+\) VALUES \((\d+),(\d+),(\d+)/;
my ($rid, $rinvoiceid, $ruserid) = ($1, $2, $3);
if (grep {$rinvoiceid == $_} @invoiceids) {
log_trace "Adding invoice item %s for invoice #%s", $rid, $rinvoiceid;
push @sql, $_;
}
}
}
FIND_HOSTINGS:
{
last unless $args{restore_hostings};
open my $fh, "<", "tblhosting"
or return [500, "Can't open $sql_backup_dir/tblhosting: $!"];
while (<$fh>) {
next unless /^INSERT INTO `tblhosting` \(`id`, `userid`, [^)]+\) VALUES \((\d+),(\d+),(\d+)/;
my ($rid, $ruserid) = ($1, $2, $3);
if ($ruserid == $clientid) {
log_trace "Found hosting for client in backup: ID=%d", $rid;
push @sql, $_;
}
}
}
FIND_DOMAINS:
{
last unless $args{restore_domains};
open my $fh, "<", "tbldomains"
or return [500, "Can't open $sql_backup_dir/tbldomains: $!"];
while (<$fh>) {
next unless /^INSERT INTO `tbldomains` \(`id`, `userid`, [^)]+\) VALUES \((\d+),(\d+),(\d+)/;
my ($rid, $ruserid) = ($1, $2, $3);
if ($ruserid == $clientid) {
log_trace "Found domain for client in backup: ID=%d", $rid;
push @sql, $_;
}
}
}
# TODO: tickets?
# records in tblaccounts (transactions) are not deleted when client is
# deleted
[200, "OK", \@sql];
}
sub _add_monthly_revs {
my ($row, $date1, $date2, $date_old_limit) = @_;
if ($date2) {
my ($y1, $m1) = $date1 =~ /\A(\d{4})-(\d{2})-(\d{2})/
or die "Can't parse date1 '$date1'";
my ($y2, $m2) = $date2 =~ /\A(\d{4})-(\d{2})-(\d{2})/
or die "Can't parse date2 '$date2'";
# first calculate how many months
my ($y, $m) = ($y1, $m1);
my $num_months = 0;
while (1) {
$num_months++;
last if $y == $y2 && $m == $m2;
$m++; if ($m == 13) { $m = 1; $y++ }
}
($y, $m) = ($y1, $m1);
for my $i (1..$num_months) {
my $key = sprintf("rev_%04d_%02d", $y, $m);
if ($date_old_limit) {
$date_old_limit =~ /^(\d{4})-(\d{2})/;
$key = "rev_past" if $key lt "rev_${1}_$2";
}
$row->{$key} += $row->{amount} / $num_months;
$m++; if ($m == 13) { $m = 1; $y++ }
}
} else {
$date1 =~ /\A(\d{4})-(\d{2})-(\d{2})/
or die "Can't parse date '$date1'";
$row->{"rev_${1}_${2}"} = $row->{amount};
}
}
$SPEC{calc_deferred_revenue} = {
v => 1.1,
description => <<'_',
Deferring revenue is the process of recognizing revenue as you earn it, in
contrast to as you receive the cash. This is the principle of accrual
accounting, as opposed to cash-based accounting.
For example, suppose on Nov 1, 2019 you receive an amount of $12 for 12 months
of hosting (up until Oct 31, 2020). In cash-based accounting, you immediately
recognize the $12 as revenue on Nov 1, 2019. In accrual accounting, you
recognize $1 revenue for each month you are performing the hosting obligation,
for 12 times, from Nov 2019 to Oct 2020.
lib/App/WHMCSUtils.pm view on Meta::CPAN
End at this date (based on invoice payment date).
=item * B<date_old_limit> => I<date>
Set what date will be considered too old to recognize item as revenue.
Default is 2008-01-01.
=item * B<date_start> => I<date>
Start from this date (based on invoice payment date).
=item * B<db_host> => I<str> (default: "localhost")
=item * B<db_name>* => I<str>
=item * B<db_pass> => I<str>
=item * B<db_port> => I<net::port> (default: 3306)
=item * B<db_user> => I<str>
=item * B<extra_rules> => I<array[hash]>
Example (in JSON):
[
{
"type": "^$",
"description": "^SEWA",
"category": "rent"
}
]
=item * B<full> => I<true>
=item * B<output_file> => I<filename>
=back
Returns an enveloped result (an array).
First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (any)
=head2 restore_whmcs_client
Usage:
restore_whmcs_client(%args) -> [$status_code, $reason, $payload, \%result_meta]
Restore a missing client from SQL database backup.
This function is not exported.
This function supports dry-run operation.
Arguments ('*' denotes required arguments):
=over 4
=item * B<client_email> => I<str>
=item * B<client_id> => I<posint>
=item * B<restore_domains> => I<bool> (default: 1)
=item * B<restore_hostings> => I<bool> (default: 1)
=item * B<restore_invoices> => I<bool> (default: 1)
=item * B<sql_backup_dir> => I<dirname>
Directory containing per-table SQL files.
=item * B<sql_backup_file> => I<filename>
Can accept either C<.sql> or C<.sql.gz>.
Will be converted first to a directory where the SQL file will be extracted to
separate files on a per-table basis.
=back
Special arguments:
=over 4
=item * B<-dry_run> => I<bool>
Pass -dry_run=E<gt>1 to enable simulation mode.
=back
Returns an enveloped result (an array).
First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (any)
=head2 send_verification_emails
Usage:
send_verification_emails(%args) -> [$status_code, $reason, $payload, \%result_meta]
Send verification emails for clients who have not had their email verified.
WHMCS does not yet provide an API for this, so we do this via a headless
browser.
This function is not exported.
This function supports dry-run operation.
Arguments ('*' denotes required arguments):
=over 4
=item * B<action> => I<str> (default: "send-verification-emails")
The default action is to send verification emails. You can also just list the
clients who haven't got their email verified yet.
=item * B<admin_password>* => I<str>
=item * B<admin_username>* => I<str>
( run in 0.466 second using v1.01-cache-2.11-cpan-2398b32b56e )