The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
 / 
Perlbug-2.89
/ Perlbug::Base

NAME

Perlbug::Base - Module for bringing together Config, Log, Do(wrapper functions), Database, all Objects etc.

DESCRIPTION

Perlbug application interface, expected to be subclassed by actual interfaces, and/or used as configuration manager/reader.

see Perlbug::Interface::Cmd, Perlbug::Interface::Web etc.

SYNOPSIS

        my $o_base = Perlbug::Base->new;

        print "System maintainer contact: ".$o_base->system('maintainer');

        print "Total bugs: ".$o_base->object('bug')->ids;

        my $o_user = $o_base->object('user')->read('richard');

        print 'User('.$o_user->attr('name').') data: '.$o_user->format('l');

METHODS

new

Create new Perlbug object, (see also Description above):

        my $o_base = Perlbug::Base->new();

Loading casualties from the log:

        [0]  INIT (18214) scr(/usr/local/httpd/htdocs/perlbug/admin/perlbug.cgi), debug(01xX) Perlbug::Log=HASH(0x860ef1c)
        [1]  Connect host(localhost), db(perlbug), user(perlbug), pass(sqlpassword)
        [2]  Connected to perlbug: 42 tables
        [3]  Perlbug 2.52 loaded 21 objects(@objects)

                Startup:  0 wallclock secs ( 0.10 usr +  0.00 sys =  0.10 CPU)
        Loaded :  0 wallclock secs ( 0.27 usr +  0.00 sys =  0.27 CPU)
        Runtime:  0 wallclock secs ( 0.06 usr +  0.00 sys =  0.06 CPU)
        Alltook:  0 wallclock secs ( 0.43 usr +  0.00 sys =  0.43 CPU)
                                  including 44 SQL statements
init

Initialize Base object

        my $self = $o_base->init;
conf

Return Config object

        my $o_conf = $o_base->conf;
cgi

Get and set CGI->new object

db

get database object

log

get log object

debug

Debug method, logs to "log_file", with configurable levels of tracking:

Controlled by $ENV{'Perlbug_DEBUG'} or $Perlbug::DEBUG or $o_base->current('debug')

Note that current('debug') will always override any local setting, being as it purports to be the application debug level, unless it is set to an empty string => ' '

        0 = login, interface, function (basic)  (if debug =~ /\w+/)     
        1 = decisions                                                   (sets 01) 
        2 = data feedback from within methods   (sets 012msX)
        3 = more than you want                                  (sets 0123mMsSxX)

        m = method names
        M = Method names (fully qualified)
        s = sql statements (num rows affected)
        S = SQL returns values (dump)
        x = execute statements (not SELECTs)
        X = EXecute returned n-results
_debug

Quiet form of debug(), just calls the file method, and will never carp or confess, so the user generally won't see the contents of the message

logg

Files args to log file

        $o_base->logg('Done something');
get_rand_msgid

Returns randomised recognisableid . processid . rand(time)

        my $it = get_rand_msgid();

An alternative might be:

        my $msgid = "<19870502_$$.$time.$count@rfi.net>";
splice

Returns a given Mail::Internet object s(p)liced up into useful bits.

    my ($o_hdr, $header, $body) = $self->splice($o_int); # todo ---sig
object

Return appropriate (cached) object:

        my $o_bug = $o_obj->object('Bug'); 

        my $o_usr = $o_obj->object('User');

For a relationship, the correct syntax would, (though deprecated, unsupported and generally disparaged :), be of the form source->target eg;

        my $o_bug_patch = $o_obj->object('bug->patch', '', 'to');

A relationship is taken care of by a special method: see Perlbug::Object::relation()

All Object know what relationships they have: see Perlbug::Object::relations()

etc.

version

Get Perlbug::Version

        my $vers = $o_base->version;
isatest

Get and set isa test status

        my $i_isatest = $o_base->isatest( [01] );
myurl

Store and return the given url.

        my $url = $o_base->myurl( $url );
href

Cheat Wrapper for Object::href

dodgy_addresses

Returns quotemeta'd, OR-d dodgy addresses prepared for a pattern match ...|...|...

        my $regex = $o_obj->dodgy_addresses('from'); 
        
        # $regex  = 'perlbug\@perl\.com|perl5\-porters\@perl\.org|...'
objects

Return list of names of objects in application, by type

        my @objnames = $o_pb->objects('mail');

        my @flags = $o_pb->objects('flag');
flags

Returns array of options for given type.

    my @list = $pb->flags('group');
all_flags

Return all flags available in db keyed by type/ident.

    my %flags = $pb->all_flags;

        %flags = ( # now looks like this:
                'group'         => ['core', 'docs', 'install'],         # ...
                'status'        => ['open', 'onhold', 'closed'],        # ...
                # ...
        );
date_hash

Returns convenient date hash structure with sql query for values

        my %dates = $o_base->date_hash;


        # 'this week' => 'TO_DAYS(SYSDATE()) - TO_DAYS(created) <= 7'
help

Returns help message for perlbug database.

        my $help = $pb->help;
spec

Returns spec message for perlbug database.

        print $pb->spec;
check_user

Checks given user is registered in the database as an admin.

Sets userid in admin and thereby status for later reference.

        $pb->check_user($user_name);
isadmin

Returns current admin userid (post check_user), checks whether system is restricted or not.

        print 'current user: '.$pb->isadmin; # name | ''
switches

Returns array of appropriate switches based on isadmin or arg.

        my @switches = $o_pb->switches([admin|user]); # exlusive
create_file

Create new file with this data:

    $ok = $self->create("$dir/$file.tmp", $data);
prioritise

Set priority nicer by given integer, or by 12.

set_user

Sets the given user to the runner of this script.

read

First we look in site, then docs...

        my @data = $o_base->read('header'); # or footer or mailhelp
target2file

Return appropriate dir/file.ext for given target string

        my $filename = $o_base->target2file('header'); # -> '~/text/header'
clean_cache

Application objects/methods may call this to clean the sql and/or object cache, particularly useful when objects or their relationships are being created or deleted:

It will not do so while application cacheing is on unless used with the 'force' command.

See also cachable()

Returns self

        my $o_obj = $o_obj->clean_cache([], [force]);           # all (sql, objects, time)

        my $o_obj = $o_obj->clean_cache('sql', [force]);        # just sql

        my $o_obj = $o_obj->clean_cache('object', [force]); # just objects
get_list

Returns a simple list of items (column values?), from a sql query.

Optional second parameter overrides sql statement/result cacheing.

        my @list = $pb->get_list('SELECT COUNT(bugid) FROM db_table', ['refresh']);
get_data

Returns a list of hash references, from a sql query.

Optional second parameter overrides sql statement/result cacheing.

        my @hash_refs = $pb->get_data('SELECT * FROM db_table', ['refresh']);
exec

Returns statement handle from sql query.

        my $sth = $pb->exec($sql);
extant

Track bugids from this session

        my @extant = $o_base->extant($bugid);
exists

Does this bugid exist in the db?

notify

Notify all relevant parties of incoming item

        my $i_ok = $o_base->notify('bug', '19870502.007');
setup_int

Setup Mail::Internet object from given args, body is default unless given.

        my $o_int = $o_base->setup_int(\%header, [$body]);   # 'to' => 'to@x.net'

or

        my $o_int = $o_base->setup_int($db_header, [$body]); # could be folded
notify_cc

Notify db_bug_address addresses of changes, given current/original status of bug.

        my $i_ok = $o_base->notify_cc($bugid, $orig);
track

Track some function or modification to the db.

        $sth = $self->track($obj, $id, $entry);
ck822

Email address checker (RFC822) courtesy Tom Christiansen/Jeffrey Friedl.

    print (($o_email->ck822($addr)) ? "yup($addr)\n" : "nope($addr)\n");
htpasswd

Modify, add, delete, comment out entries in .htpasswd

    $i_ok = $o_web->htpasswd($userid, $pass);   # entry ok?

    @entries = $o_web->htpasswd;                # returns list of entries ('userid:passwd', 'user2:pass2'...)
clean_up

Clean up previous logs activity whenever run, and report briefly on how long this process took.

Exits when done.

tell_time

Put runtime info in log file, if $Perlbug::DEBUG

        my $feedback = $o_base->tell_time(Benchmark->new);
parse_str

Returns hash of data extracted from given string.

Matches are 'nearest wins' after 4 places ie; clos=closed.

        my %cmds = $o_obj->parse_str('5.0.5_444_aix_irix_<bugid>_etc' | (qw(patchid bugid etc));

        %cmds = (
                'bugids'                => \@bugids,
                'change'        => {
                        'ids'   => [qw(3)],
                        'names' => [qw(553)],
                },
                'osname'        => {
                        'ids'   => [qw(12 14)],
                        'names' => [qw(aix macos irix)],
                },
                'unknown'       => {
                        'ids'   => [qw(0123456789)],
                        'names' => [qw(etc)],
                },
        );
scan

Scan for perl relevant data putting found or default switches in $h_data.

Looking for both group=docs and '\brunning\s*under\ssome\s*perl' style markers.

    my $h_data = $o_mail->scan($body);

Migrate to return parse_str() style hashref

bugid_2_addresses

Return addresses based on context

        my @addrs = $o_email->bugid_2_addresses($bugid);
compare

Compare two arrays: returns 1 if identical, 0 if not.

    my $identical = compare(\@arry1, \@arry2); # tomc

AUTHOR

Richard Foley perlbug@rfi.net 1999 2000 2001