diff --git a/docs/SCRATCH_INSTALL.txt b/docs/SCRATCH_INSTALL.txt index 79654fef..7d086257 100644 --- a/docs/SCRATCH_INSTALL.txt +++ b/docs/SCRATCH_INSTALL.txt @@ -622,8 +622,8 @@ PHASE 4: INSTALLING ASTERISK OK, all the prep work is done, now it's time to start having fun with Asterisk. There are two basic ways to install Asterisk, an official release(at the time of -this writing the official release is 1.2.10) and the SVN_DEV version(development -branch). We recommend using Asterisk 1.2.10. These instructions are how we get +this writing the official release is 1.2.11) and the SVN_DEV version(development +branch). We recommend using Asterisk 1.2.11. These instructions are how we get our Asterisk system with it's T1 line installed with our 2 SIP VOIP devices and one IAX2 softphone. @@ -638,13 +638,13 @@ with the following patch: - mkdir /usr/src/asterisk - cd /usr/src/asterisk A. if you want 1.2 release (reliable with new features): - - wget http://ftp.digium.com/pub/asterisk/releases/asterisk-1.2.10.tar.gz - - wget http://ftp.digium.com/pub/zaptel/releases/zaptel-1.2.7.tar.gz + - wget http://ftp.digium.com/pub/asterisk/releases/asterisk-1.2.11.tar.gz + - wget http://ftp.digium.com/pub/zaptel/releases/zaptel-1.2.8.tar.gz - wget http://ftp.digium.com/pub/libpri/releases/libpri-1.2.3.tar.gz - - gunzip asterisk-1.2.10.tar.gz - - tar xvf asterisk-1.2.10.tar - - gunzip zaptel-1.2.7.tar.gz - - tar xvf zaptel-1.2.7.tar + - gunzip asterisk-1.2.11.tar.gz + - tar xvf asterisk-1.2.11.tar + - gunzip zaptel-1.2.8.tar.gz + - tar xvf zaptel-1.2.8.tar - gunzip libpri-1.2.3.tar.gz - tar xvf libpri-1.2.3.tar B. if you want latest SVN_DEV version (sometimes unstable) [1.3 tree] @@ -665,7 +665,7 @@ with the following patch: edit this line at the top and just add a hash # in front of it as shown: #PBX_LIBS+=$(shell $(CROSS_COMPILE_BIN)gtk-config --cflags >/dev/null 2>/dev/null && echo "pbx_gtkconsole.so") - - cd ./zaptel-1.2.7 + - cd ./zaptel-1.2.8 - make clean - make - make install @@ -673,7 +673,7 @@ with the following patch: - make clean - make - make install - - cd ../asterisk-1.2.10 + - cd ../asterisk-1.2.11 - (1.2 tree) If you want to include Answering Machine Detection ability you will need to download app_amd.c and amd.conf and alter the apps/Makefile to compile it properly diff --git a/extras/AST_VICI_conf.pl.bak b/extras/AST_VICI_conf.pl.bak deleted file mode 100644 index c4039f2b..00000000 --- a/extras/AST_VICI_conf.pl.bak +++ /dev/null @@ -1,146 +0,0 @@ -#!/usr/bin/perl - -### AST_VICI_conf.pl -### -### Copyright (C) 2006 Matt Florell LICENSE: GPLv2 -### - -### Customized Variables -$SIP_user = 'SIP/cc100'; # your phone id -$server_ip = '10.10.10.15'; # Asterisk server IP -$DB_server = '10.10.10.15'; # MySQL server IP -$DB_database = 'asterisk'; # MySQL database name -$DB_user = 'idcheck'; # MySQL user -$DB_pass = '1234'; # MySQL pass -$DB_port = '3306'; # MySQL connection port - -### Constants -$record_channel=''; -$filename=''; -$recording_id=''; -$US = '_'; -$MT[0] = ''; - -return 1; - - -# this subroutine is to be used with the callerID function to customize the -# variables that are passed in the URL string and the way that they are passed, -# these are the variables you have to work with: -# $callerID_areacode -# $callerID_prefix -# $callerID_last4 -# $callerID_Time -# $callerID_Channel -# $callerID_uniqueID -# $callerID_phone_ext -# $callerID_server_ip -# $callerID_extension -# $callerID_inbound_number -# $callerID_comment_a -# $callerID_comment_b -# $callerID_comment_c -# $callerID_comment_d -# $callerID_comment_e - -sub create_callerID_local_query_string -{ -$local_web_callerID_QUERY_STRING =''; -$local_web_callerID_QUERY_STRING.="?callerID_areacode=$callerID_areacode"; -$local_web_callerID_QUERY_STRING.="&callerID_prefix=$callerID_prefix"; -$local_web_callerID_QUERY_STRING.="&callerID_last4=$callerID_last4"; -$local_web_callerID_QUERY_STRING.="&callerID_Time=$callerID_Time"; -$local_web_callerID_QUERY_STRING.="&callerID_Channel=$callerID_Channel"; -$local_web_callerID_QUERY_STRING.="&callerID_uniqueID=$callerID_uniqueID"; -$local_web_callerID_QUERY_STRING.="&callerID_phone_ext=$callerID_phone_ext"; -$local_web_callerID_QUERY_STRING.="&callerID_server_ip=$callerID_server_ip"; -$local_web_callerID_QUERY_STRING.="&callerID_extension=$callerID_extension"; -$local_web_callerID_QUERY_STRING.="&callerID_inbound_number=$callerID_inbound_number"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_a=$callerID_comment_a"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_b=$callerID_comment_b"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_c=$callerID_comment_c"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_d=$callerID_comment_d"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_e=$callerID_comment_e"; -} - -# $lead_id -# $vendor_id -# $list_id -# $phone_code -# $phone_number -# $title -# $first_name -# $middle_initial -# $last_name -# $address1 -# $address2 -# $address3 -# $city -# $state -# $province -# $postal_code -# $country_code -# $gender -# $date_of_birth -# $alt_phone -# $email -# $security -# $comments -# $user -# $pass -# $fronter -# $closer -# $campaign -# $group -# $SQLdate -# $epoch -# $uniqueid -# $customer_zap_channel -# $server_ip -# $SIPexten - -sub create_VICIDIAL_query_string -{ -$VICIDIAL_web_QUERY_STRING =''; -$VICIDIAL_web_QUERY_STRING.="?lead_id=$lead_id"; -$VICIDIAL_web_QUERY_STRING.="&vendor_id=$vendor_id"; -$VICIDIAL_web_QUERY_STRING.="&list_id=$list_id"; -$VICIDIAL_web_QUERY_STRING.="&phone_code=$phone_code"; -$VICIDIAL_web_QUERY_STRING.="&phone_number=$phone_number"; -$VICIDIAL_web_QUERY_STRING.="&title=$title"; -$VICIDIAL_web_QUERY_STRING.="&first_name=$first_name"; -$VICIDIAL_web_QUERY_STRING.="&middle_initial=$middle_initial"; -$VICIDIAL_web_QUERY_STRING.="&last_name=$last_name"; -$VICIDIAL_web_QUERY_STRING.="&address1=$address1"; -$VICIDIAL_web_QUERY_STRING.="&address2=$address2"; -$VICIDIAL_web_QUERY_STRING.="&address3=$address3"; -$VICIDIAL_web_QUERY_STRING.="&city=$city"; -$VICIDIAL_web_QUERY_STRING.="&state=$state"; -$VICIDIAL_web_QUERY_STRING.="&province=$province"; -$VICIDIAL_web_QUERY_STRING.="&postal_code=$postal_code"; -$VICIDIAL_web_QUERY_STRING.="&country_code=$country_code"; -$VICIDIAL_web_QUERY_STRING.="&gender=$gender"; -$VICIDIAL_web_QUERY_STRING.="&date_of_birth=$date_of_birth"; -$VICIDIAL_web_QUERY_STRING.="&alt_phone=$alt_phone"; -$VICIDIAL_web_QUERY_STRING.="&email=$email"; -$VICIDIAL_web_QUERY_STRING.="&security=$security"; -$VICIDIAL_web_QUERY_STRING.="&comments=$comments"; -$VICIDIAL_web_QUERY_STRING.="&user=$user"; -$VICIDIAL_web_QUERY_STRING.="&pass=$userpass"; -$VICIDIAL_web_QUERY_STRING.="&fronter=$fronter"; -$VICIDIAL_web_QUERY_STRING.="&closer=$user"; -$VICIDIAL_web_QUERY_STRING.="&campaign=$campaign"; -$VICIDIAL_web_QUERY_STRING.="&group=$group"; -$VICIDIAL_web_QUERY_STRING.="&channel_group=$channel_group"; -$VICIDIAL_web_QUERY_STRING.="&SQLdate=$SQLdate"; -$VICIDIAL_web_QUERY_STRING.="&epoch=$secX"; -$VICIDIAL_web_QUERY_STRING.="&uniqueid=$uniqueid"; -$VICIDIAL_web_QUERY_STRING.="&customer_zap_channel=$customer_zap_channel"; -$VICIDIAL_web_QUERY_STRING.="&server_ip=$server_ip"; -$VICIDIAL_web_QUERY_STRING.="&SIPexten=$SIPexten"; -$VICIDIAL_web_QUERY_STRING.="&session_id=$session_id"; -$VICIDIAL_web_QUERY_STRING.="&phone=$phone_number"; -$VICIDIAL_web_QUERY_STRING.="&parked_by=$lead_id"; -$VICIDIAL_web_QUERY_STRING =~ s/ /+/gi; -$VICIDIAL_web_QUERY_STRING =~ s/\`|\~|\:|\;|\#|\'|\"|\{|\}|\(|\)|\*|\^|\%|\$|\!|\%|\r|\t|\n//gi; -} \ No newline at end of file diff --git a/extras/Asterisk/DONOTUSE_AST_VICI_conf.pl b/extras/Asterisk/DONOTUSE_AST_VICI_conf.pl deleted file mode 100644 index c4039f2b..00000000 --- a/extras/Asterisk/DONOTUSE_AST_VICI_conf.pl +++ /dev/null @@ -1,146 +0,0 @@ -#!/usr/bin/perl - -### AST_VICI_conf.pl -### -### Copyright (C) 2006 Matt Florell LICENSE: GPLv2 -### - -### Customized Variables -$SIP_user = 'SIP/cc100'; # your phone id -$server_ip = '10.10.10.15'; # Asterisk server IP -$DB_server = '10.10.10.15'; # MySQL server IP -$DB_database = 'asterisk'; # MySQL database name -$DB_user = 'idcheck'; # MySQL user -$DB_pass = '1234'; # MySQL pass -$DB_port = '3306'; # MySQL connection port - -### Constants -$record_channel=''; -$filename=''; -$recording_id=''; -$US = '_'; -$MT[0] = ''; - -return 1; - - -# this subroutine is to be used with the callerID function to customize the -# variables that are passed in the URL string and the way that they are passed, -# these are the variables you have to work with: -# $callerID_areacode -# $callerID_prefix -# $callerID_last4 -# $callerID_Time -# $callerID_Channel -# $callerID_uniqueID -# $callerID_phone_ext -# $callerID_server_ip -# $callerID_extension -# $callerID_inbound_number -# $callerID_comment_a -# $callerID_comment_b -# $callerID_comment_c -# $callerID_comment_d -# $callerID_comment_e - -sub create_callerID_local_query_string -{ -$local_web_callerID_QUERY_STRING =''; -$local_web_callerID_QUERY_STRING.="?callerID_areacode=$callerID_areacode"; -$local_web_callerID_QUERY_STRING.="&callerID_prefix=$callerID_prefix"; -$local_web_callerID_QUERY_STRING.="&callerID_last4=$callerID_last4"; -$local_web_callerID_QUERY_STRING.="&callerID_Time=$callerID_Time"; -$local_web_callerID_QUERY_STRING.="&callerID_Channel=$callerID_Channel"; -$local_web_callerID_QUERY_STRING.="&callerID_uniqueID=$callerID_uniqueID"; -$local_web_callerID_QUERY_STRING.="&callerID_phone_ext=$callerID_phone_ext"; -$local_web_callerID_QUERY_STRING.="&callerID_server_ip=$callerID_server_ip"; -$local_web_callerID_QUERY_STRING.="&callerID_extension=$callerID_extension"; -$local_web_callerID_QUERY_STRING.="&callerID_inbound_number=$callerID_inbound_number"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_a=$callerID_comment_a"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_b=$callerID_comment_b"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_c=$callerID_comment_c"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_d=$callerID_comment_d"; -$local_web_callerID_QUERY_STRING.="&callerID_comment_e=$callerID_comment_e"; -} - -# $lead_id -# $vendor_id -# $list_id -# $phone_code -# $phone_number -# $title -# $first_name -# $middle_initial -# $last_name -# $address1 -# $address2 -# $address3 -# $city -# $state -# $province -# $postal_code -# $country_code -# $gender -# $date_of_birth -# $alt_phone -# $email -# $security -# $comments -# $user -# $pass -# $fronter -# $closer -# $campaign -# $group -# $SQLdate -# $epoch -# $uniqueid -# $customer_zap_channel -# $server_ip -# $SIPexten - -sub create_VICIDIAL_query_string -{ -$VICIDIAL_web_QUERY_STRING =''; -$VICIDIAL_web_QUERY_STRING.="?lead_id=$lead_id"; -$VICIDIAL_web_QUERY_STRING.="&vendor_id=$vendor_id"; -$VICIDIAL_web_QUERY_STRING.="&list_id=$list_id"; -$VICIDIAL_web_QUERY_STRING.="&phone_code=$phone_code"; -$VICIDIAL_web_QUERY_STRING.="&phone_number=$phone_number"; -$VICIDIAL_web_QUERY_STRING.="&title=$title"; -$VICIDIAL_web_QUERY_STRING.="&first_name=$first_name"; -$VICIDIAL_web_QUERY_STRING.="&middle_initial=$middle_initial"; -$VICIDIAL_web_QUERY_STRING.="&last_name=$last_name"; -$VICIDIAL_web_QUERY_STRING.="&address1=$address1"; -$VICIDIAL_web_QUERY_STRING.="&address2=$address2"; -$VICIDIAL_web_QUERY_STRING.="&address3=$address3"; -$VICIDIAL_web_QUERY_STRING.="&city=$city"; -$VICIDIAL_web_QUERY_STRING.="&state=$state"; -$VICIDIAL_web_QUERY_STRING.="&province=$province"; -$VICIDIAL_web_QUERY_STRING.="&postal_code=$postal_code"; -$VICIDIAL_web_QUERY_STRING.="&country_code=$country_code"; -$VICIDIAL_web_QUERY_STRING.="&gender=$gender"; -$VICIDIAL_web_QUERY_STRING.="&date_of_birth=$date_of_birth"; -$VICIDIAL_web_QUERY_STRING.="&alt_phone=$alt_phone"; -$VICIDIAL_web_QUERY_STRING.="&email=$email"; -$VICIDIAL_web_QUERY_STRING.="&security=$security"; -$VICIDIAL_web_QUERY_STRING.="&comments=$comments"; -$VICIDIAL_web_QUERY_STRING.="&user=$user"; -$VICIDIAL_web_QUERY_STRING.="&pass=$userpass"; -$VICIDIAL_web_QUERY_STRING.="&fronter=$fronter"; -$VICIDIAL_web_QUERY_STRING.="&closer=$user"; -$VICIDIAL_web_QUERY_STRING.="&campaign=$campaign"; -$VICIDIAL_web_QUERY_STRING.="&group=$group"; -$VICIDIAL_web_QUERY_STRING.="&channel_group=$channel_group"; -$VICIDIAL_web_QUERY_STRING.="&SQLdate=$SQLdate"; -$VICIDIAL_web_QUERY_STRING.="&epoch=$secX"; -$VICIDIAL_web_QUERY_STRING.="&uniqueid=$uniqueid"; -$VICIDIAL_web_QUERY_STRING.="&customer_zap_channel=$customer_zap_channel"; -$VICIDIAL_web_QUERY_STRING.="&server_ip=$server_ip"; -$VICIDIAL_web_QUERY_STRING.="&SIPexten=$SIPexten"; -$VICIDIAL_web_QUERY_STRING.="&session_id=$session_id"; -$VICIDIAL_web_QUERY_STRING.="&phone=$phone_number"; -$VICIDIAL_web_QUERY_STRING.="&parked_by=$lead_id"; -$VICIDIAL_web_QUERY_STRING =~ s/ /+/gi; -$VICIDIAL_web_QUERY_STRING =~ s/\`|\~|\:|\;|\#|\'|\"|\{|\}|\(|\)|\*|\^|\%|\$|\!|\%|\r|\t|\n//gi; -} \ No newline at end of file diff --git a/extras/Asterisk/buttons.gif b/extras/Asterisk/buttons.gif deleted file mode 100644 index 6de93e84..00000000 Binary files a/extras/Asterisk/buttons.gif and /dev/null differ diff --git a/extras/Asterisk/vm_indicator_anim.gif b/extras/Asterisk/vm_indicator_anim.gif deleted file mode 100644 index 9445e76f..00000000 Binary files a/extras/Asterisk/vm_indicator_anim.gif and /dev/null differ diff --git a/extras/Asterisk/voicemail_digits.gif b/extras/Asterisk/voicemail_digits.gif deleted file mode 100644 index 4ed7026f..00000000 Binary files a/extras/Asterisk/voicemail_digits.gif and /dev/null differ diff --git a/extras/Asterisk/voicemail_new.gif b/extras/Asterisk/voicemail_new.gif deleted file mode 100644 index 240d4ef8..00000000 Binary files a/extras/Asterisk/voicemail_new.gif and /dev/null differ diff --git a/extras/Asterisk/voicemail_old.gif b/extras/Asterisk/voicemail_old.gif deleted file mode 100644 index a9bbc75e..00000000 Binary files a/extras/Asterisk/voicemail_old.gif and /dev/null differ diff --git a/extras/Asterisk/voicemail_up.gif b/extras/Asterisk/voicemail_up.gif deleted file mode 100644 index 8e6fda81..00000000 Binary files a/extras/Asterisk/voicemail_up.gif and /dev/null differ diff --git a/extras/MySQL.pm b/extras/MySQL.pm deleted file mode 100644 index e6a92c80..00000000 --- a/extras/MySQL.pm +++ /dev/null @@ -1,1015 +0,0 @@ -package Net::MySQL; - -use 5.004; -use IO::Socket; -use Carp; -use vars qw($VERSION $DEBUG); -use strict; -$VERSION = '0.08'; - -use constant COMMAND_SLEEP => "\x00"; -use constant COMMAND_QUIT => "\x01"; -use constant COMMAND_INIT_DB => "\x02"; -use constant COMMAND_QUERY => "\x03"; -use constant COMMAND_FIELD_LIST => "\x04"; -use constant COMMAND_CREATE_DB => "\x05"; -use constant COMMAND_DROP_DB => "\x06"; -use constant COMMAND_REFRESH => "\x07"; -use constant COMMAND_SHUTDOWN => "\x08"; -use constant COMMAND_STATISTICS => "\x09"; -use constant COMMAND_PROCESS_INFO => "\x0A"; -use constant COMMAND_CONNECT => "\x0B"; -use constant COMMAND_PROCESS_KILL => "\x0C"; -use constant COMMAND_DEBUG => "\x0D"; -use constant COMMAND_PING => "\x0E"; -use constant COMMAND_TIME => "\x0F"; -use constant COMMAND_DELAYED_INSERT => "\x10"; -use constant COMMAND_CHANGE_USER => "\x11"; -use constant COMMAND_BINLOG_DUMP => "\x12"; -use constant COMMAND_TABLE_DUMP => "\x13"; -use constant COMMAND_CONNECT_OUT => "\x14"; - -use constant DEFAULT_PORT_NUMBER => 3306; -use constant BUFFER_LENGTH => 1460; -use constant DEFAULT_UNIX_SOCKET => '/tmp/mysql.sock'; - - -sub new -{ - my $class = shift; - my %args = @_; - - my $self = bless { - hostname => $args{hostname}, - unixsocket => $args{unixsocket} || DEFAULT_UNIX_SOCKET, - port => $args{port} || DEFAULT_PORT_NUMBER, - database => $args{database}, - user => $args{user}, - password => $args{password}, - timeout => $args{timeout} || 60, - socket => undef, - salt => '', - protocol_version => undef, - client_capabilities => 0, - affected_rows_length => 0, - }, $class; - $self->debug($args{debug}); - $self->_initialize; - return $self; -} - - -sub query -{ - my $self = shift; - my $sql = join '', @_; - my $mysql = $self->{socket}; - - return $self->_execute_command(COMMAND_QUERY, $sql); -} - - -sub create_database -{ - my $self = shift; - my $db_name = shift; - my $mysql = $self->{socket}; - - return $self->_execute_command(COMMAND_CREATE_DB, $db_name); -} - - -sub drop_database -{ - my $self = shift; - my $db_name = shift; - my $mysql = $self->{socket}; - - return $self->_execute_command(COMMAND_DROP_DB, $db_name); -} - - -sub close -{ - my $self = shift; - my $mysql = $self->{socket}; - return unless $mysql->can('send'); - - my $quit_message = - chr(length(COMMAND_QUIT)). "\x00\x00\x00". COMMAND_QUIT; - $mysql->send($quit_message, 0); - $self->_dump_packet($quit_message) if Net::MySQL->debug; - $mysql->close; -} - - -sub get_affected_rows_length -{ - my $self = shift; - $self->{affected_rows_length}; -} - - -sub get_insert_id -{ - my $self = shift; - $self->{insert_id}; -} - - -sub create_record_iterator -{ - my $self = shift; - return undef unless $self->has_selected_record; - - my $record = Net::MySQL::RecordIterator->new( - $self->{selected_record} - ); - $self->{selected_record} = undef; - $record->parse; - return $record; -} - - -sub has_selected_record -{ - my $self = shift; - $self->{selected_record} ? 1 : undef; -} - - -sub is_error -{ - my $self = shift; - $self->{error_code} ? 1 : undef; -} - - -sub get_error_code -{ - my $self = shift; - $self->{error_code}; -} - - -sub get_error_message -{ - my $self = shift; - $self->{server_message}; -} - - -sub debug -{ - my $class = shift; - $DEBUG = shift if @_; - $DEBUG; -} - - -sub _connect -{ - my $self = shift; - - my $mysql; - if ($self->{hostname}) { - printf "Use INET Socket: %s %d/tcp\n", $self->{hostname}, $self->{port} - if $self->debug; - $mysql = IO::Socket::INET->new( - PeerAddr => $self->{hostname}, - PeerPort => $self->{port}, - Proto => 'tcp', - Timeout => $self->{timeout} || 60, - ) or croak "Couldn't connect to $self->{hostname}:$self->{port}/tcp: $@"; - } - else { - printf "Use UNIX Socket: %s\n", $self->{unixsocket} if $self->debug; - $mysql = IO::Socket::UNIX->new( - Type => SOCK_STREAM, - Peer => $self->{unixsocket}, - ) or croak "Couldn't connect to $self->{unixsocket}: $@"; - } - $mysql->autoflush(1); - $self->{socket} = $mysql; -} - - -sub _get_server_information -{ - my $self = shift; - my $mysql = $self->{socket}; - - my $message; - $mysql->recv($message, BUFFER_LENGTH, 0); - $self->_dump_packet($message) - if Net::MySQL->debug; - my $i = 0; - my $packet_length = ord substr $message, $i, 1; - $i += 4; - $self->{protocol_version} = ord substr $message, $i, 1; - printf "Protocol Version: %d\n", $self->{protocol_version} - if Net::MySQL->debug; - if ($self->{protocol_version} == 10) { - $self->{client_capabilities} = 1; - } - - ++$i; - my $string_end = index($message, "\0", $i) - $i; - $self->{server_version} = substr $message, $i, $string_end; - printf "Server Version: %s\n", $self->{server_version} - if Net::MySQL->debug; - - $i += $string_end + 1; - $self->{server_thread_id} = unpack 'v', substr $message, $i, 2; - $i += 4; - $self->{salt} = substr $message, $i, 8; - printf "Salt: %s\n", $self->{salt} if Net::MySQL->debug; -} - - -sub _request_authentication -{ - my $self = shift; - my $mysql = $self->{socket}; - $self->_send_login_message(); - - my $auth_result; - $mysql->recv($auth_result, BUFFER_LENGTH, 0); - $self->_dump_packet($auth_result) if Net::MySQL->debug; - if ($self->_is_error($auth_result)) { - $mysql->close; - if (length $auth_result < 7) { - croak "Timeout of authentication"; - } - croak substr $auth_result, 7; - } - print "connect database\n" if Net::MySQL->debug; -} - - -sub _send_login_message -{ - my $self = shift; - my $mysql = $self->{socket}; - - my $body = "\0\0\x01\x8d\x00\00\00\00". join "\0", - $self->{user}, - Net::MySQL::Password->scramble( - $self->{password}, $self->{salt}, $self->{client_capabilities} - ), - $self->{database}; - my $login_message = chr(length($body)-3). $body; - $mysql->send($login_message, 0); - $self->_dump_packet($login_message) if Net::MySQL->debug; -} - - - -sub _execute_command -{ - my $self = shift; - my $command = shift; - my $sql = shift; - my $mysql = $self->{socket}; - - my $message = pack('V', length($sql) + 1). $command. $sql; - - $mysql->send($message, 0); - $self->_dump_packet($message) if Net::MySQL->debug; - - my $result; - $mysql->recv($result, BUFFER_LENGTH, 0); - $self->_dump_packet($result) if Net::MySQL->debug; - $self->_reset_status; - - if ($self->_is_error($result)) { - return $self->_set_error_by_packet($result); - } - elsif ($self->_is_select_query_result($result)) { - return $self->_get_record_by_server($result); - } - elsif ($self->_is_update_query_result($result)){ - return $self->_get_affected_rows_information_by_packet($result); - } - else { - croak 'Unknown Result: '. $self->_get_result_length($result). 'byte'; - } -} - - -sub _initialize -{ - my $self = shift; - $self->_connect; - $self->_get_server_information; - $self->_request_authentication; -} - - -sub _set_error_by_packet -{ - my $self = shift; - my $packet = shift; - - my $error_message = $self->_get_server_message($packet); - $self->{server_message} = $error_message; - $self->{error_code} = $self->_get_error_code($packet); - return undef; -} - - -sub _get_record_by_server -{ - my $self = shift; - my $packet = shift; - my $mysql = $self->{socket}; - - $self->_get_column_length($packet); - while ($self->_has_next_packet($packet)) { - my $next_result; - $mysql->recv($next_result, BUFFER_LENGTH, 0); - $packet .= $next_result; - $self->_dump_packet($next_result) if Net::MySQL->debug; - } - $self->{selected_record} = $packet; -} - - -sub _get_affected_rows_information_by_packet -{ - my $self = shift; - my $packet = shift; - - $self->{affected_rows_length} = $self->_get_affected_rows_length($packet); - $self->{insert_id} = $self->_get_insert_id($packet); - $self->{server_message} = $self->_get_server_message($packet); - return $self->{affected_rows_length}; -} - - -sub _is_error -{ - my $self = shift; - my $packet = shift; - return 1 if length $packet < 4; - ord(substr $packet, 4) == 255; -} - - -sub _is_select_query_result -{ - my $self = shift; - my $packet = shift; - return undef if $self->_is_error($packet); - ord(substr $packet, 4) >= 1; -} - - -sub _is_update_query_result -{ - my $self = shift; - my $packet = shift; - return undef if $self->_is_error($packet); - ord(substr $packet, 4) == 0; -} - - -sub _get_result_length -{ - my $self = shift; - my $packet = shift; - ord(substr $packet, 0, 1) -} - - -sub _get_column_length -{ - my $self = shift; - my $packet = shift; - ord(substr $packet, 4); -} - - -sub _get_affected_rows_length -{ - my $self = shift; - my $packet = shift; - ord(substr $packet, 5, 1); -} - - -sub _get_insert_id -{ - my $self = shift; - my $packet = shift; - return ord(substr $packet, 6, 1) if ord(substr $packet, 6, 1) != 0xfc; - unpack 'v', substr $packet, 7, 2; -} - - -sub _get_server_message -{ - my $self = shift; - my $packet = shift; - return '' if length $packet < 7; - substr $packet, 7; -} - - -sub _get_error_code -{ - my $self = shift; - my $packet = shift; - $self->_is_error($packet) - or croak "_get_error_code(): Is not error packet"; - unpack 'v', substr $packet, 5, 2; -} - - -sub _reset_status -{ - my $self = shift; - $self->{insert_id} = 0; - $self->{server_message} = ''; - $self->{error_code} = undef; - $self->{selected_record} = undef; -} - - -sub _has_next_packet -{ - my $self = shift; - substr($_[0], -1) ne "\xfe"; -} - - -sub _dump_packet -{ - my $self = shift; - my $packet = shift; - - my ($method_name) = (caller(1))[3]; - printf "%s():\n%s\n", - $method_name, - join ' ', map { sprintf "%02x", ord $_ } split //, $packet; - printf "%s():\n%s\n", - $method_name, - join ' ', map { m/[\d \w\._]/ ? $_ : '.' } split //, $packet; - print "--\n"; -} - - - -package Net::MySQL::RecordIterator; -use strict; - -use constant NULL_COLUMN => 251; -use constant UNSIGNED_CHAR_COLUMN => 251; -use constant UNSIGNED_SHORT_COLUMN => 252; -use constant UNSIGNED_INT24_COLUMN => 253; -use constant UNSIGNED_INT32_COLUMN => 254; -use constant UNSIGNED_CHAR_LENGTH => 1; -use constant UNSIGNED_SHORT_LENGTH => 2; -use constant UNSIGNED_INT24_LENGTH => 3; -use constant UNSIGNED_INT32_LENGTH => 4; -use constant UNSIGNED_INT32_PAD_LENGTH => 4; - - -sub new -{ - my $class = shift; - my $packet = shift; - bless { - packet => $packet, - position => 0, - column => [], - }, $class; -} - - -sub parse -{ - my $self = shift; - $self->_get_column_length; - $self->_get_column_name; -} - - -sub each -{ - my $self = shift; - my @result; - return undef if $self->is_end_of_packet; - - for (1..$self->{column_length}) { - push @result, $self->_get_string_and_seek_position; - } - $self->{position} += 4; - return \@result; -} - - -sub is_end_of_packet -{ - my $self = shift; - length $self->{packet} <= $self->{position} + 1; -} - - -sub get_field_length -{ - my $self = shift; - $self->{column_length}; -} - - -sub get_field_names -{ - my $self = shift; - map { $_->{column} } @{$self->{column}}; -} - - -sub _get_column_length -{ - my $self = shift; - $self->{position} += 4; - $self->{column_length} = ord substr $self->{packet}, $self->{position}, 1; - $self->{position} += 5; - printf "Column Length: %d\n", $self->{column_length} - if Net::MySQL->debug; -} - - -sub _get_column_name -{ - my $self = shift; - for my $i (1.. $self->{column_length}) { - push @{$self->{column}}, { - table => $self->_get_string_and_seek_position, - column => $self->_get_string_and_seek_position, - }; - $self->{position} += 14; - } - $self->{position} += 5; - - printf "Column name: %s\n", - join ", ", map { $_->{column} } @{$self->{column}} - if Net::MySQL->debug; -} - - -sub _get_string_and_seek_position -{ - my $self = shift; - - my $length = $self->_get_field_length(); - return undef unless defined $length; - - my $string = substr $self->{packet}, $self->{position}, $length; - $self->{position} += $length; - return $string; -} - - -sub _get_field_length -{ - my $self = shift; - - my $head = ord substr( - $self->{packet}, - $self->{position}, - UNSIGNED_CHAR_LENGTH - ); - $self->{position} += UNSIGNED_CHAR_LENGTH; - - return undef if $head == NULL_COLUMN; - if ($head < UNSIGNED_CHAR_COLUMN) { - return $head; - } - elsif ($head == UNSIGNED_SHORT_COLUMN) { - warn "in short"; - my $length = unpack 'v', substr( - $self->{packet}, - $self->{position}, - UNSIGNED_SHORT_LENGTH - ); - $self->{position} += UNSIGNED_SHORT_LENGTH; - return $length; - } - elsif ($head == UNSIGNED_INT24_COLUMN) { - warn "in int23"; - my $int24 = substr( - $self->{packet}, $self->{position}, - UNSIGNED_INT24_LENGTH - ); - my $length = unpack('C', substr($int24, 0, 1)) - + (unpack('C', substr($int24, 1, 1)) << 8) - + (unpack('C', substr($int24, 2, 1)) << 16); - $self->{position} += UNSIGNED_INT24_LENGTH; - return $length; - } - else { - warn "in int32"; - my $int32 = substr( - $self->{packet}, $self->{position}, - UNSIGNED_INT32_LENGTH - ); - my $length = unpack('C', substr($int32, 0, 1)) - + (unpack('C', substr($int32, 1, 1)) << 8) - + (unpack('C', substr($int32, 2, 1)) << 16) - + (unpack('C', substr($int32, 3, 1)) << 24); - $self->{position} += UNSIGNED_INT32_LENGTH; - $self->{position} += UNSIGNED_INT32_PAD_LENGTH; - return $length; - } -} - - -package Net::MySQL::Password; -use strict; - -sub scramble -{ - my $class = shift; - my $password = shift; - my $hash_seed = shift; - my $client_capabilities = shift; - - return '' unless $password; - return '' if length $password == 0; - - my $hsl = length $hash_seed; - my @out; - my @hash_pass = _get_hash($password); - my @hash_mess = _get_hash($hash_seed); - - my ($max_value, $seed, $seed2); - my ($dRes, $dSeed, $dMax); - if ($client_capabilities < 1) { - $max_value = 0x01FFFFFF; - $seed = _xor_by_long($hash_pass[0], $hash_mess[0]) % $max_value; - $seed2 = int($seed / 2); - } else { - $max_value= 0x3FFFFFFF; - $seed = _xor_by_long($hash_pass[0], $hash_mess[0]) % $max_value; - $seed2 = _xor_by_long($hash_pass[1], $hash_mess[1]) % $max_value; - } - $dMax = $max_value; - - for (my $i=0; $i < $hsl; $i++) { - $seed = int(($seed * 3 + $seed2) % $max_value); - $seed2 = int(($seed + $seed2 + 33) % $max_value); - $dSeed = $seed; - $dRes = $dSeed / $dMax; - push @out, int($dRes * 31) + 64; - } - - if ($client_capabilities == 1) { - # Make it harder to break - $seed = ($seed * 3 + $seed2 ) % $max_value; - $seed2 = ($seed + $seed2 + 33 ) % $max_value; - $dSeed = $seed; - - $dRes = $dSeed / $dMax; - my $e = int($dRes * 31); - for (my $i=0; $i < $hsl ; $i++) { - $out[$i] ^= $e; - } - } - return join '', map { chr $_ } @out; -} - - -sub _get_hash -{ - my $password = shift; - - my $nr = 1345345333; - my $add = 7; - my $nr2 = 0x12345671; - my $tmp; - my $pwlen = length $password; - my $c; - - for (my $i=0; $i < $pwlen; $i++) { - my $c = substr $password, $i, 1; - next if $c eq ' ' || $c eq "\t"; - my $tmp = ord $c; - my $value = ((_and_by_char($nr, 63) + $add) * $tmp) + $nr * 256; - $nr = _xor_by_long($nr, $value); - $nr2 += _xor_by_long(($nr2 * 256), $nr); - $add += $tmp; - } - return (_and_by_long($nr, 0x7fffffff), _and_by_long($nr2, 0x7fffffff)); -} - - -sub _and_by_char -{ - my $source = shift; - my $mask = shift; - - return $source & $mask; -} - - -sub _and_by_long -{ - my $source = shift; - my $mask = shift || 0xFFFFFFFF; - - return _cut_off_to_long($source) & _cut_off_to_long($mask); -} - - -sub _xor_by_long -{ - my $source = shift; - my $mask = shift || 0; - - return _cut_off_to_long($source) ^ _cut_off_to_long($mask); -} - - -sub _cut_off_to_long -{ - my $source = shift; - - if ($] >= 5.006) { - $source = $source % (0xFFFFFFFF + 1) if $source > 0xFFFFFFFF; - return $source; - } - while ($source > 0xFFFFFFFF) { - $source -= 0xFFFFFFFF + 1; - } - return $source; -} - - -1; -__END__ - -=head1 NAME - -Net::MySQL - Pure Perl MySQL network protocol interface. - -=head1 SYNOPSIS - - use Net::MySQL; - - my $mysql = Net::MySQL->new( - # hostname => 'mysql.example.jp', # Default use UNIX socket - database => 'your_database_name', - user => 'user', - password => 'password' - ); - - # INSERT example - $mysql->query(q{ - INSERT INTO tablename (first, next) VALUES ('Hello', 'World') - }); - printf "Affected row: %d\n", $mysql->get_affected_rows_length; - - # SLECT example - $mysql->query(q{SELECT * FROM tablename}); - my $record_set = $mysql->create_record_iterator; - while (my $record = $record_set->each) { - printf "First column: %s Next column: %s\n", - $record->[0], $record->[1]; - } - $mysql->close; - -=head1 DESCRIPTION - -Net::MySQL is a Pure Perl client interface for the MySQL database. This module implements network protocol between server and client of MySQL, thus you don't need external MySQL client library like libmysqlclient for this module to work. It means this module enables you to connect to MySQL server from some operation systems which MySQL is not ported. How nifty! - -Since this module's final goal is to completely replace DBD::mysql, API is made similar to that of DBI. - -From perl you activate the interface with the statement - - use Net::MySQL; - -After that you can connect to multiple MySQL daemon and send multiple queries to any of them via a simple object oriented interface. - -There are two classes which have public APIs: Net::MySQL and Net::MySQL::RecordIterator. - - $mysql = Net::MySQL->new( - hostname => $host, - database => $database, - user => $user, - password => $password, - ); - -Once you have connected to a daemon, you can can execute SQL with: - - $mysql->query(q{ - INSERT INTO foo (id, message) VALUES (1, 'Hello World') - }); - -If you want to retrieve results, you need to create a so-called statement handle with: - - $mysql->query(q{ - SELECT id, message FROM foo - }); - if ($mysql->has_selected_record) { - my $a_record_iterator = $mysql->create_record_iterator; - # ... - } - -This Net::MySQL::RecordIterator object can be used for multiple purposes. First of all you can retreive a row of data: - - my $record = $a_record_iterator->each; - -The each() method takes out the reference result of one line at a time, and the return value is ARRAY reference. - -=head2 Net::MySQL API - -=over 4 - -=item new(HASH) - - use Net::MySQL; - use strict; - - my $mysql = Net::MySQL->new( - unixsocket => $path_to_socket, - hostname => $host, - database => $database, - user => $user, - password => $password, - ); - -The constructor of Net::MySQL. Connection with MySQL daemon is established and the object is returned. Argument hash contains following parameters: - -=over 8 - -=item unixsocket - -Path of the UNIX socket where MySQL daemon. default is F. -Supposing I is omitted, it will connect by I. - -=item hostname - -Name of the host where MySQL daemon runs. -Supposing I is specified, it will connect by I. - -=item port - -Port where MySQL daemon listens to. default is 3306. - -=item database - -Name of the database to connect. - -=item user / password - -Username and password for database authentication. - -=item timeout - -The waiting time which carries out a timeout when connection is overdue is specified. - -=item debug - -The exchanged packet will be outputted if a true value is given. - -=back - - -=item create_database(DB_NAME) - -A create_DATABASE() method creates a database by the specified name. - - $mysql->create_database('example_db'); - die $mysql->get_error_message if $mysql->is_error; - -=item drop_database(DB_NAME) - -A drop_database() method deletes the database of the specified name. - - $mysql->drop_database('example_db'); - die $mysql->get_error_message if $mysql->is_error; - -=item query(SQL_STRING) - -A query() method transmits the specified SQL string to MySQL database, and obtains the response. - -=item create_record_iterator() - -When SELECT type SQL is specified, Net::MySQL::RecordIterator object which shows the reference result is returned. - - $mysql->query(q{SELECT * FROM table}); - my $a_record_iterator = $mysql->create_recrod_iterator(); - -Net::MySQL::RecordIterator object is applicable to acquisition of a reference result. See L<"/Net::SQL::RecordIterator API"> for more. - -=item get_affected_rows_length() - -returns the number of records finally influenced by specified SQL. - - my $affected_rows = $mysql->get_affected_rows_length; - -=item get_insert_id() - -MySQL has the ability to choose unique key values automatically. If this happened, the new ID will be stored in this attribute. - -=item is_error() - -TRUE will be returned if the error has occurred. - -=item has_selected_record() - -TRUE will be returned if it has a reference result by SELECT. - -=item get_field_length() - -return the number of column. - -=item get_field_names() - -return column names by ARRAY. - -=item close() - -transmits an end message to MySQL daemon, and closes a socket. - -=back - -=head2 Net::MySQL::RecordIterator API - -Net::MySQL::RecordIterator object is generated by the query() method of Net::MySQL object. Thus it has no public constructor method. - -=over 4 - -=item each() - -each() method takes out only one line from a result, and returns it as an ARRAY reference. C is returned when all the lines has been taken out. - - while (my $record = $a_record_iterator->each) { - printf "Column 1: %s Column 2: %s Collumn 3: %s\n", - $record->[0], $record->[1], $record->[2]; - } - -=back - -=head1 SUPPORT OPERATING SYSTEM - -This module has been tested on these OSes. - -=over 4 - -=item * MacOS 9.x - -with MacPerl5.6.1r. - -=item * MacOS X - -with perl5.6.0 build for darwin. - -=item * Windows2000 - -with ActivePerl5.6.1 build631. - -=item * FreeBSD 3.4 and 4.x - -with perl5.6.1 build for i386-freebsd. - -with perl5.005_03 build for i386-freebsd. - -=item * Linux - -with perl 5.005_03 built for ppc-linux. - -with perl 5.6.0 bult for i386-linux. - -=item * Solaris 2.6 (SPARC) - -with perl 5.6.1 built for sun4-solaris. - -with perl 5.004_04 built for sun4-solaris. - -Can use on Solaris2.6 with perl5.004_04, although I is failure. - -=back - -This list is the environment which I can use by the test usually. Net::MySQL will operate also in much environment which is not in a list. - -I believe this module can work with whatever perls which has B. I'll be glad if you give me a report of successful installation of this module on I OSes. - -=head1 SEE ALSO - -L, L - -=head1 AUTHOR - -Hiroyuki OYAMA Eoyama@module.jpE - -=head1 COPYRIGHT AND LICENCE - -Copyright (C) 2002 Hiroyuki OYAMA. Japan. All rights reserved. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/extras/Net/HTTP.pm b/extras/Net/HTTP.pm deleted file mode 100644 index 80786825..00000000 --- a/extras/Net/HTTP.pm +++ /dev/null @@ -1,266 +0,0 @@ -package Net::HTTP; - -# $Id: HTTP.pm,v 1.43 2002/12/26 09:13:53 gisle Exp $ - -use strict; -use vars qw($VERSION @ISA); - -$VERSION = "1.00"; -eval { require IO::Socket::INET } || require IO::Socket; -require Net::HTTP::Methods; - -@ISA=qw(IO::Socket::INET Net::HTTP::Methods); - -sub configure { - my($self, $cnf) = @_; - $self->http_configure($cnf); -} - -sub http_connect { - my($self, $cnf) = @_; - $self->SUPER::configure($cnf); -} - -1; - -__END__ - -=head1 NAME - -Net::HTTP - Low-level HTTP connection (client) - -=head1 SYNOPSIS - - use Net::HTTP; - my $s = Net::HTTP->new(Host => "www.perl.com) || die $@; - $s->write_request(GET => "/", 'User-Agent' => "Mozilla/5.0"); - my($code, $mess, %h) = $s->read_response_headers; - - while (1) { - my $buf; - my $n = $s->read_entity_body($buf, 1024); - die "read failed: $!" unless defined $n; - last unless $n; - print $buf; - } - -=head1 DESCRIPTION - -The C class is a low-level HTTP client. An instance of the -C class represents a connection to an HTTP server. The -HTTP protocol is described in RFC 2616. The C class -support C and C. - -C is a sub-class of C. You can mix the -methods described below with reading and writing from the socket -directly. This is not necessary a good idea, unless you know what you -are doing. - -The following methods are provided (in addition to those of -C): - -=over - -=item $s = Net::HTTP->new( %options ) - -The C constructor method takes the same options as -C's as well as these: - - Host: Initial host attribute value - KeepAlive: Initial keep_alive attribute value - SendTE: Initial send_te attribute_value - HTTPVersion: Initial http_version attribute value - PeerHTTPVersion: Initial peer_http_version attribute value - MaxLineLength: Initial max_line_length attribute value - MaxHeaderLines: Initial max_header_lines attribute value - -The C option is also the default for C's -C. The C defaults to 80 if not provided. - -The C option provided by C's constructor -method is not allowed. - -If unable to connect to the given HTTP server then the constructor -returns C and $@ contains the reason. After a successful -connect, a C object is returned. - -=item $s->host - -Get/set the default value of the C header to send. The $host -should not be set to an empty string (or C). - -=item $s->keep_alive - -Get/set the I value. If this value is TRUE then the -request will be sent with headers indicating that the server should try -to keep the connection open so that multiple requests can be sent. - -The actual headers set will depend on the value of the C -and C attributes. - -=item $s->send_te - -Get/set the a value indicating if the request will be sent with a "TE" -header to indicate the transfer encodings that the server can chose to -use. If the C module is installed then this will -annouce that this client accept both the I and I -encodings. - -=item $s->http_version - -Get/set the HTTP version number that this client should announce. -This value can only be set to "1.0" or "1.1". The default is "1.1". - -=item $s->peer_http_version - -Get/set the protocol version number of our peer. This value will -initially be "1.0", but will be updated by a successful -read_response_headers() method call. - -=item $s->max_line_length - -Get/set a limit on the length of response line and response header -lines. The default is 4096. A value of 0 means no limit. - -=item $s->max_header_length - -Get/set a limit on the number of headers lines that a response can -have. The default is 128. A value of 0 means no limit. - -=item $s->format_request($method, $uri, %headers, [$content]) - -Format a request message and return it as a string. If the headers do -not include a C header, then a header is inserted with the value -of the C attribute. Headers like C and -C might also be added depending on the status of the -C attribute. - -If $content is given (and it is non-empty), then a C -header is automatically added unless it was already present. - -=item $s->write_request($method, $uri, %headers, [$content]) - -Format and send a request message. Arguments are the same as for -format_request(). Returns true if successful. - -=item $s->format_chunk( $data ) - -Returns the string to be written for the given chunk of data. - -=item $s->write_chunk($data) - -Will write a new chunk of request entity body data. This method -should only be used if the C header with a value of -C was sent in the request. Note, writing zero-length data is -a no-op. Use the write_chunk_eof() method to signal end of entity -body data. - -Returns true if successful. - -=item $s->format_chunk_eof( %trailers ) - -Returns the string to be written for signaling EOF when a -C of C is used. - -=item $s->write_chunk_eof( %trailers ) - -Will write eof marker for chunked data and optional trailers. Note -that trailers should not really be used unless is was signaled -with a C header. - -Returns true if successful. - -=item ($code, $mess, %headers) = $s->read_response_headers( %opts ) - -Read response headers from server and return it. The $code is the 3 -digit HTTP status code (see L) and $mess is the textual -message that came with it. Headers are then returned as key/value -pairs. Since key letter casing is not normalized and the same key can -even occur multiple times, assigning these values directly to a hash -is not wise. Only the $code is returned if this method is called in -scalar context. - -As a side effect this method updates the 'peer_http_version' -attribute. - -Options might be passed in as key/value pairs. There are currently -only two options supported; C and C. - -The C option will make read_response_headers() more forgiving -towards servers that have not learned how to speak HTTP properly. The -C option is a boolean flag, and is enabled by passing in a TRUE -value. The C option can be used to capture bad header lines -when C is enabled. The value should be an array reference. -Bad header lines will be pushed onto the array. - -The C option must be specified in order to communicate with -pre-HTTP/1.0 servers that don't describe the response outcome or the -data they send back with a header block. For these servers -peer_http_version is set to "0.9" and this method returns (200, -"Assumed OK"). - -The method will raise an exception (die) if the server does not speak -proper HTTP or if the C or C -limits are reached. If the C option is turned on and -C and C checks are turned off, -then no exception will be raised and this method will always -return a response code. - -=item $n = $s->read_entity_body($buf, $size); - -Reads chunks of the entity body content. Basically the same interface -as for read() and sysread(), but the buffer offset argument is not -supported yet. This method should only be called after a successful -read_response_headers() call. - -The return value will be C on read errors, 0 on EOF, -1 if no data -could be returned this time, otherwise the number of bytes assgined -to $buf. The $buf set to "" when the return value is -1. - -This method will raise exceptions (die) if the server does not speak -proper HTTP. This can only happen when reading chunked data. - -=item %headers = $s->get_trailers - -After read_entity_body() has returned 0 to indicate end of the entity -body, you might call this method to pick up any trailers. - -=item $s->_rbuf - -Get/set the read buffer content. The read_response_headers() and -read_entity_body() methods use an internal buffer which they will look -for data before they actually sysread more from the socket itself. If -they read too much, the remaining data will be left in this buffer. - -=item $s->_rbuf_length - -Returns the number of bytes in the read buffer. This should always be -the same as: - - length($s->_rbuf) - -but might be more efficient. - -=back - -=head1 SUBCLASSING - -The read_response_headers() and read_entity_body() will invoke the -sysread() method when they need more data. Subclasses might want to -override this method to contol how reading takes place. - -The object itself is a glob. Subclasses should avoid using hash key -names prefixed with C and C. - -=head1 SEE ALSO - -L, L, L - -=head1 COPYRIGHT - -Copyright 2001-2003 Gisle Aas. - -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=cut diff --git a/extras/Net/HTTPS.pm b/extras/Net/HTTPS.pm deleted file mode 100644 index 1549a06d..00000000 --- a/extras/Net/HTTPS.pm +++ /dev/null @@ -1,55 +0,0 @@ -package Net::HTTPS; - -# $Id: HTTPS.pm,v 1.3 2002/12/23 18:16:29 gisle Exp $ - -use strict; -use vars qw($VERSION $SSL_SOCKET_CLASS @ISA); - -$VERSION = "1.00"; - -# Figure out which SSL implementation to use -if ($IO::Socket::SSL::VERSION) { - $SSL_SOCKET_CLASS = "IO::Socket::SSL"; # it was already loaded -} -else { - eval { require Net::SSL; }; # from Crypt-SSLeay - if ($@) { - my $old_errsv = $@; - eval { - require IO::Socket::SSL; - }; - if ($@) { - $old_errsv =~ s/\s\(\@INC contains:.*\)/)/g; - die $old_errsv . $@; - } - $SSL_SOCKET_CLASS = "IO::Socket::SSL"; - } - else { - $SSL_SOCKET_CLASS = "Net::SSL"; - } -} - -require Net::HTTP::Methods; - -@ISA=($SSL_SOCKET_CLASS, 'Net::HTTP::Methods'); - -sub configure { - my($self, $cnf) = @_; - $self->http_configure($cnf); -} - -sub http_connect { - my($self, $cnf) = @_; - $self->SUPER::configure($cnf); -} - -sub http_default_port { - 443; -} - -# The underlying SSLeay classes fails to work if the socket is -# placed in non-blocking mode. This override of the blocking -# method makes sure it stays the way it was created. -sub blocking { } # noop - -1; diff --git a/extras/Net/MySQL.pm b/extras/Net/MySQL.pm deleted file mode 100644 index e6a92c80..00000000 --- a/extras/Net/MySQL.pm +++ /dev/null @@ -1,1015 +0,0 @@ -package Net::MySQL; - -use 5.004; -use IO::Socket; -use Carp; -use vars qw($VERSION $DEBUG); -use strict; -$VERSION = '0.08'; - -use constant COMMAND_SLEEP => "\x00"; -use constant COMMAND_QUIT => "\x01"; -use constant COMMAND_INIT_DB => "\x02"; -use constant COMMAND_QUERY => "\x03"; -use constant COMMAND_FIELD_LIST => "\x04"; -use constant COMMAND_CREATE_DB => "\x05"; -use constant COMMAND_DROP_DB => "\x06"; -use constant COMMAND_REFRESH => "\x07"; -use constant COMMAND_SHUTDOWN => "\x08"; -use constant COMMAND_STATISTICS => "\x09"; -use constant COMMAND_PROCESS_INFO => "\x0A"; -use constant COMMAND_CONNECT => "\x0B"; -use constant COMMAND_PROCESS_KILL => "\x0C"; -use constant COMMAND_DEBUG => "\x0D"; -use constant COMMAND_PING => "\x0E"; -use constant COMMAND_TIME => "\x0F"; -use constant COMMAND_DELAYED_INSERT => "\x10"; -use constant COMMAND_CHANGE_USER => "\x11"; -use constant COMMAND_BINLOG_DUMP => "\x12"; -use constant COMMAND_TABLE_DUMP => "\x13"; -use constant COMMAND_CONNECT_OUT => "\x14"; - -use constant DEFAULT_PORT_NUMBER => 3306; -use constant BUFFER_LENGTH => 1460; -use constant DEFAULT_UNIX_SOCKET => '/tmp/mysql.sock'; - - -sub new -{ - my $class = shift; - my %args = @_; - - my $self = bless { - hostname => $args{hostname}, - unixsocket => $args{unixsocket} || DEFAULT_UNIX_SOCKET, - port => $args{port} || DEFAULT_PORT_NUMBER, - database => $args{database}, - user => $args{user}, - password => $args{password}, - timeout => $args{timeout} || 60, - socket => undef, - salt => '', - protocol_version => undef, - client_capabilities => 0, - affected_rows_length => 0, - }, $class; - $self->debug($args{debug}); - $self->_initialize; - return $self; -} - - -sub query -{ - my $self = shift; - my $sql = join '', @_; - my $mysql = $self->{socket}; - - return $self->_execute_command(COMMAND_QUERY, $sql); -} - - -sub create_database -{ - my $self = shift; - my $db_name = shift; - my $mysql = $self->{socket}; - - return $self->_execute_command(COMMAND_CREATE_DB, $db_name); -} - - -sub drop_database -{ - my $self = shift; - my $db_name = shift; - my $mysql = $self->{socket}; - - return $self->_execute_command(COMMAND_DROP_DB, $db_name); -} - - -sub close -{ - my $self = shift; - my $mysql = $self->{socket}; - return unless $mysql->can('send'); - - my $quit_message = - chr(length(COMMAND_QUIT)). "\x00\x00\x00". COMMAND_QUIT; - $mysql->send($quit_message, 0); - $self->_dump_packet($quit_message) if Net::MySQL->debug; - $mysql->close; -} - - -sub get_affected_rows_length -{ - my $self = shift; - $self->{affected_rows_length}; -} - - -sub get_insert_id -{ - my $self = shift; - $self->{insert_id}; -} - - -sub create_record_iterator -{ - my $self = shift; - return undef unless $self->has_selected_record; - - my $record = Net::MySQL::RecordIterator->new( - $self->{selected_record} - ); - $self->{selected_record} = undef; - $record->parse; - return $record; -} - - -sub has_selected_record -{ - my $self = shift; - $self->{selected_record} ? 1 : undef; -} - - -sub is_error -{ - my $self = shift; - $self->{error_code} ? 1 : undef; -} - - -sub get_error_code -{ - my $self = shift; - $self->{error_code}; -} - - -sub get_error_message -{ - my $self = shift; - $self->{server_message}; -} - - -sub debug -{ - my $class = shift; - $DEBUG = shift if @_; - $DEBUG; -} - - -sub _connect -{ - my $self = shift; - - my $mysql; - if ($self->{hostname}) { - printf "Use INET Socket: %s %d/tcp\n", $self->{hostname}, $self->{port} - if $self->debug; - $mysql = IO::Socket::INET->new( - PeerAddr => $self->{hostname}, - PeerPort => $self->{port}, - Proto => 'tcp', - Timeout => $self->{timeout} || 60, - ) or croak "Couldn't connect to $self->{hostname}:$self->{port}/tcp: $@"; - } - else { - printf "Use UNIX Socket: %s\n", $self->{unixsocket} if $self->debug; - $mysql = IO::Socket::UNIX->new( - Type => SOCK_STREAM, - Peer => $self->{unixsocket}, - ) or croak "Couldn't connect to $self->{unixsocket}: $@"; - } - $mysql->autoflush(1); - $self->{socket} = $mysql; -} - - -sub _get_server_information -{ - my $self = shift; - my $mysql = $self->{socket}; - - my $message; - $mysql->recv($message, BUFFER_LENGTH, 0); - $self->_dump_packet($message) - if Net::MySQL->debug; - my $i = 0; - my $packet_length = ord substr $message, $i, 1; - $i += 4; - $self->{protocol_version} = ord substr $message, $i, 1; - printf "Protocol Version: %d\n", $self->{protocol_version} - if Net::MySQL->debug; - if ($self->{protocol_version} == 10) { - $self->{client_capabilities} = 1; - } - - ++$i; - my $string_end = index($message, "\0", $i) - $i; - $self->{server_version} = substr $message, $i, $string_end; - printf "Server Version: %s\n", $self->{server_version} - if Net::MySQL->debug; - - $i += $string_end + 1; - $self->{server_thread_id} = unpack 'v', substr $message, $i, 2; - $i += 4; - $self->{salt} = substr $message, $i, 8; - printf "Salt: %s\n", $self->{salt} if Net::MySQL->debug; -} - - -sub _request_authentication -{ - my $self = shift; - my $mysql = $self->{socket}; - $self->_send_login_message(); - - my $auth_result; - $mysql->recv($auth_result, BUFFER_LENGTH, 0); - $self->_dump_packet($auth_result) if Net::MySQL->debug; - if ($self->_is_error($auth_result)) { - $mysql->close; - if (length $auth_result < 7) { - croak "Timeout of authentication"; - } - croak substr $auth_result, 7; - } - print "connect database\n" if Net::MySQL->debug; -} - - -sub _send_login_message -{ - my $self = shift; - my $mysql = $self->{socket}; - - my $body = "\0\0\x01\x8d\x00\00\00\00". join "\0", - $self->{user}, - Net::MySQL::Password->scramble( - $self->{password}, $self->{salt}, $self->{client_capabilities} - ), - $self->{database}; - my $login_message = chr(length($body)-3). $body; - $mysql->send($login_message, 0); - $self->_dump_packet($login_message) if Net::MySQL->debug; -} - - - -sub _execute_command -{ - my $self = shift; - my $command = shift; - my $sql = shift; - my $mysql = $self->{socket}; - - my $message = pack('V', length($sql) + 1). $command. $sql; - - $mysql->send($message, 0); - $self->_dump_packet($message) if Net::MySQL->debug; - - my $result; - $mysql->recv($result, BUFFER_LENGTH, 0); - $self->_dump_packet($result) if Net::MySQL->debug; - $self->_reset_status; - - if ($self->_is_error($result)) { - return $self->_set_error_by_packet($result); - } - elsif ($self->_is_select_query_result($result)) { - return $self->_get_record_by_server($result); - } - elsif ($self->_is_update_query_result($result)){ - return $self->_get_affected_rows_information_by_packet($result); - } - else { - croak 'Unknown Result: '. $self->_get_result_length($result). 'byte'; - } -} - - -sub _initialize -{ - my $self = shift; - $self->_connect; - $self->_get_server_information; - $self->_request_authentication; -} - - -sub _set_error_by_packet -{ - my $self = shift; - my $packet = shift; - - my $error_message = $self->_get_server_message($packet); - $self->{server_message} = $error_message; - $self->{error_code} = $self->_get_error_code($packet); - return undef; -} - - -sub _get_record_by_server -{ - my $self = shift; - my $packet = shift; - my $mysql = $self->{socket}; - - $self->_get_column_length($packet); - while ($self->_has_next_packet($packet)) { - my $next_result; - $mysql->recv($next_result, BUFFER_LENGTH, 0); - $packet .= $next_result; - $self->_dump_packet($next_result) if Net::MySQL->debug; - } - $self->{selected_record} = $packet; -} - - -sub _get_affected_rows_information_by_packet -{ - my $self = shift; - my $packet = shift; - - $self->{affected_rows_length} = $self->_get_affected_rows_length($packet); - $self->{insert_id} = $self->_get_insert_id($packet); - $self->{server_message} = $self->_get_server_message($packet); - return $self->{affected_rows_length}; -} - - -sub _is_error -{ - my $self = shift; - my $packet = shift; - return 1 if length $packet < 4; - ord(substr $packet, 4) == 255; -} - - -sub _is_select_query_result -{ - my $self = shift; - my $packet = shift; - return undef if $self->_is_error($packet); - ord(substr $packet, 4) >= 1; -} - - -sub _is_update_query_result -{ - my $self = shift; - my $packet = shift; - return undef if $self->_is_error($packet); - ord(substr $packet, 4) == 0; -} - - -sub _get_result_length -{ - my $self = shift; - my $packet = shift; - ord(substr $packet, 0, 1) -} - - -sub _get_column_length -{ - my $self = shift; - my $packet = shift; - ord(substr $packet, 4); -} - - -sub _get_affected_rows_length -{ - my $self = shift; - my $packet = shift; - ord(substr $packet, 5, 1); -} - - -sub _get_insert_id -{ - my $self = shift; - my $packet = shift; - return ord(substr $packet, 6, 1) if ord(substr $packet, 6, 1) != 0xfc; - unpack 'v', substr $packet, 7, 2; -} - - -sub _get_server_message -{ - my $self = shift; - my $packet = shift; - return '' if length $packet < 7; - substr $packet, 7; -} - - -sub _get_error_code -{ - my $self = shift; - my $packet = shift; - $self->_is_error($packet) - or croak "_get_error_code(): Is not error packet"; - unpack 'v', substr $packet, 5, 2; -} - - -sub _reset_status -{ - my $self = shift; - $self->{insert_id} = 0; - $self->{server_message} = ''; - $self->{error_code} = undef; - $self->{selected_record} = undef; -} - - -sub _has_next_packet -{ - my $self = shift; - substr($_[0], -1) ne "\xfe"; -} - - -sub _dump_packet -{ - my $self = shift; - my $packet = shift; - - my ($method_name) = (caller(1))[3]; - printf "%s():\n%s\n", - $method_name, - join ' ', map { sprintf "%02x", ord $_ } split //, $packet; - printf "%s():\n%s\n", - $method_name, - join ' ', map { m/[\d \w\._]/ ? $_ : '.' } split //, $packet; - print "--\n"; -} - - - -package Net::MySQL::RecordIterator; -use strict; - -use constant NULL_COLUMN => 251; -use constant UNSIGNED_CHAR_COLUMN => 251; -use constant UNSIGNED_SHORT_COLUMN => 252; -use constant UNSIGNED_INT24_COLUMN => 253; -use constant UNSIGNED_INT32_COLUMN => 254; -use constant UNSIGNED_CHAR_LENGTH => 1; -use constant UNSIGNED_SHORT_LENGTH => 2; -use constant UNSIGNED_INT24_LENGTH => 3; -use constant UNSIGNED_INT32_LENGTH => 4; -use constant UNSIGNED_INT32_PAD_LENGTH => 4; - - -sub new -{ - my $class = shift; - my $packet = shift; - bless { - packet => $packet, - position => 0, - column => [], - }, $class; -} - - -sub parse -{ - my $self = shift; - $self->_get_column_length; - $self->_get_column_name; -} - - -sub each -{ - my $self = shift; - my @result; - return undef if $self->is_end_of_packet; - - for (1..$self->{column_length}) { - push @result, $self->_get_string_and_seek_position; - } - $self->{position} += 4; - return \@result; -} - - -sub is_end_of_packet -{ - my $self = shift; - length $self->{packet} <= $self->{position} + 1; -} - - -sub get_field_length -{ - my $self = shift; - $self->{column_length}; -} - - -sub get_field_names -{ - my $self = shift; - map { $_->{column} } @{$self->{column}}; -} - - -sub _get_column_length -{ - my $self = shift; - $self->{position} += 4; - $self->{column_length} = ord substr $self->{packet}, $self->{position}, 1; - $self->{position} += 5; - printf "Column Length: %d\n", $self->{column_length} - if Net::MySQL->debug; -} - - -sub _get_column_name -{ - my $self = shift; - for my $i (1.. $self->{column_length}) { - push @{$self->{column}}, { - table => $self->_get_string_and_seek_position, - column => $self->_get_string_and_seek_position, - }; - $self->{position} += 14; - } - $self->{position} += 5; - - printf "Column name: %s\n", - join ", ", map { $_->{column} } @{$self->{column}} - if Net::MySQL->debug; -} - - -sub _get_string_and_seek_position -{ - my $self = shift; - - my $length = $self->_get_field_length(); - return undef unless defined $length; - - my $string = substr $self->{packet}, $self->{position}, $length; - $self->{position} += $length; - return $string; -} - - -sub _get_field_length -{ - my $self = shift; - - my $head = ord substr( - $self->{packet}, - $self->{position}, - UNSIGNED_CHAR_LENGTH - ); - $self->{position} += UNSIGNED_CHAR_LENGTH; - - return undef if $head == NULL_COLUMN; - if ($head < UNSIGNED_CHAR_COLUMN) { - return $head; - } - elsif ($head == UNSIGNED_SHORT_COLUMN) { - warn "in short"; - my $length = unpack 'v', substr( - $self->{packet}, - $self->{position}, - UNSIGNED_SHORT_LENGTH - ); - $self->{position} += UNSIGNED_SHORT_LENGTH; - return $length; - } - elsif ($head == UNSIGNED_INT24_COLUMN) { - warn "in int23"; - my $int24 = substr( - $self->{packet}, $self->{position}, - UNSIGNED_INT24_LENGTH - ); - my $length = unpack('C', substr($int24, 0, 1)) - + (unpack('C', substr($int24, 1, 1)) << 8) - + (unpack('C', substr($int24, 2, 1)) << 16); - $self->{position} += UNSIGNED_INT24_LENGTH; - return $length; - } - else { - warn "in int32"; - my $int32 = substr( - $self->{packet}, $self->{position}, - UNSIGNED_INT32_LENGTH - ); - my $length = unpack('C', substr($int32, 0, 1)) - + (unpack('C', substr($int32, 1, 1)) << 8) - + (unpack('C', substr($int32, 2, 1)) << 16) - + (unpack('C', substr($int32, 3, 1)) << 24); - $self->{position} += UNSIGNED_INT32_LENGTH; - $self->{position} += UNSIGNED_INT32_PAD_LENGTH; - return $length; - } -} - - -package Net::MySQL::Password; -use strict; - -sub scramble -{ - my $class = shift; - my $password = shift; - my $hash_seed = shift; - my $client_capabilities = shift; - - return '' unless $password; - return '' if length $password == 0; - - my $hsl = length $hash_seed; - my @out; - my @hash_pass = _get_hash($password); - my @hash_mess = _get_hash($hash_seed); - - my ($max_value, $seed, $seed2); - my ($dRes, $dSeed, $dMax); - if ($client_capabilities < 1) { - $max_value = 0x01FFFFFF; - $seed = _xor_by_long($hash_pass[0], $hash_mess[0]) % $max_value; - $seed2 = int($seed / 2); - } else { - $max_value= 0x3FFFFFFF; - $seed = _xor_by_long($hash_pass[0], $hash_mess[0]) % $max_value; - $seed2 = _xor_by_long($hash_pass[1], $hash_mess[1]) % $max_value; - } - $dMax = $max_value; - - for (my $i=0; $i < $hsl; $i++) { - $seed = int(($seed * 3 + $seed2) % $max_value); - $seed2 = int(($seed + $seed2 + 33) % $max_value); - $dSeed = $seed; - $dRes = $dSeed / $dMax; - push @out, int($dRes * 31) + 64; - } - - if ($client_capabilities == 1) { - # Make it harder to break - $seed = ($seed * 3 + $seed2 ) % $max_value; - $seed2 = ($seed + $seed2 + 33 ) % $max_value; - $dSeed = $seed; - - $dRes = $dSeed / $dMax; - my $e = int($dRes * 31); - for (my $i=0; $i < $hsl ; $i++) { - $out[$i] ^= $e; - } - } - return join '', map { chr $_ } @out; -} - - -sub _get_hash -{ - my $password = shift; - - my $nr = 1345345333; - my $add = 7; - my $nr2 = 0x12345671; - my $tmp; - my $pwlen = length $password; - my $c; - - for (my $i=0; $i < $pwlen; $i++) { - my $c = substr $password, $i, 1; - next if $c eq ' ' || $c eq "\t"; - my $tmp = ord $c; - my $value = ((_and_by_char($nr, 63) + $add) * $tmp) + $nr * 256; - $nr = _xor_by_long($nr, $value); - $nr2 += _xor_by_long(($nr2 * 256), $nr); - $add += $tmp; - } - return (_and_by_long($nr, 0x7fffffff), _and_by_long($nr2, 0x7fffffff)); -} - - -sub _and_by_char -{ - my $source = shift; - my $mask = shift; - - return $source & $mask; -} - - -sub _and_by_long -{ - my $source = shift; - my $mask = shift || 0xFFFFFFFF; - - return _cut_off_to_long($source) & _cut_off_to_long($mask); -} - - -sub _xor_by_long -{ - my $source = shift; - my $mask = shift || 0; - - return _cut_off_to_long($source) ^ _cut_off_to_long($mask); -} - - -sub _cut_off_to_long -{ - my $source = shift; - - if ($] >= 5.006) { - $source = $source % (0xFFFFFFFF + 1) if $source > 0xFFFFFFFF; - return $source; - } - while ($source > 0xFFFFFFFF) { - $source -= 0xFFFFFFFF + 1; - } - return $source; -} - - -1; -__END__ - -=head1 NAME - -Net::MySQL - Pure Perl MySQL network protocol interface. - -=head1 SYNOPSIS - - use Net::MySQL; - - my $mysql = Net::MySQL->new( - # hostname => 'mysql.example.jp', # Default use UNIX socket - database => 'your_database_name', - user => 'user', - password => 'password' - ); - - # INSERT example - $mysql->query(q{ - INSERT INTO tablename (first, next) VALUES ('Hello', 'World') - }); - printf "Affected row: %d\n", $mysql->get_affected_rows_length; - - # SLECT example - $mysql->query(q{SELECT * FROM tablename}); - my $record_set = $mysql->create_record_iterator; - while (my $record = $record_set->each) { - printf "First column: %s Next column: %s\n", - $record->[0], $record->[1]; - } - $mysql->close; - -=head1 DESCRIPTION - -Net::MySQL is a Pure Perl client interface for the MySQL database. This module implements network protocol between server and client of MySQL, thus you don't need external MySQL client library like libmysqlclient for this module to work. It means this module enables you to connect to MySQL server from some operation systems which MySQL is not ported. How nifty! - -Since this module's final goal is to completely replace DBD::mysql, API is made similar to that of DBI. - -From perl you activate the interface with the statement - - use Net::MySQL; - -After that you can connect to multiple MySQL daemon and send multiple queries to any of them via a simple object oriented interface. - -There are two classes which have public APIs: Net::MySQL and Net::MySQL::RecordIterator. - - $mysql = Net::MySQL->new( - hostname => $host, - database => $database, - user => $user, - password => $password, - ); - -Once you have connected to a daemon, you can can execute SQL with: - - $mysql->query(q{ - INSERT INTO foo (id, message) VALUES (1, 'Hello World') - }); - -If you want to retrieve results, you need to create a so-called statement handle with: - - $mysql->query(q{ - SELECT id, message FROM foo - }); - if ($mysql->has_selected_record) { - my $a_record_iterator = $mysql->create_record_iterator; - # ... - } - -This Net::MySQL::RecordIterator object can be used for multiple purposes. First of all you can retreive a row of data: - - my $record = $a_record_iterator->each; - -The each() method takes out the reference result of one line at a time, and the return value is ARRAY reference. - -=head2 Net::MySQL API - -=over 4 - -=item new(HASH) - - use Net::MySQL; - use strict; - - my $mysql = Net::MySQL->new( - unixsocket => $path_to_socket, - hostname => $host, - database => $database, - user => $user, - password => $password, - ); - -The constructor of Net::MySQL. Connection with MySQL daemon is established and the object is returned. Argument hash contains following parameters: - -=over 8 - -=item unixsocket - -Path of the UNIX socket where MySQL daemon. default is F. -Supposing I is omitted, it will connect by I. - -=item hostname - -Name of the host where MySQL daemon runs. -Supposing I is specified, it will connect by I. - -=item port - -Port where MySQL daemon listens to. default is 3306. - -=item database - -Name of the database to connect. - -=item user / password - -Username and password for database authentication. - -=item timeout - -The waiting time which carries out a timeout when connection is overdue is specified. - -=item debug - -The exchanged packet will be outputted if a true value is given. - -=back - - -=item create_database(DB_NAME) - -A create_DATABASE() method creates a database by the specified name. - - $mysql->create_database('example_db'); - die $mysql->get_error_message if $mysql->is_error; - -=item drop_database(DB_NAME) - -A drop_database() method deletes the database of the specified name. - - $mysql->drop_database('example_db'); - die $mysql->get_error_message if $mysql->is_error; - -=item query(SQL_STRING) - -A query() method transmits the specified SQL string to MySQL database, and obtains the response. - -=item create_record_iterator() - -When SELECT type SQL is specified, Net::MySQL::RecordIterator object which shows the reference result is returned. - - $mysql->query(q{SELECT * FROM table}); - my $a_record_iterator = $mysql->create_recrod_iterator(); - -Net::MySQL::RecordIterator object is applicable to acquisition of a reference result. See L<"/Net::SQL::RecordIterator API"> for more. - -=item get_affected_rows_length() - -returns the number of records finally influenced by specified SQL. - - my $affected_rows = $mysql->get_affected_rows_length; - -=item get_insert_id() - -MySQL has the ability to choose unique key values automatically. If this happened, the new ID will be stored in this attribute. - -=item is_error() - -TRUE will be returned if the error has occurred. - -=item has_selected_record() - -TRUE will be returned if it has a reference result by SELECT. - -=item get_field_length() - -return the number of column. - -=item get_field_names() - -return column names by ARRAY. - -=item close() - -transmits an end message to MySQL daemon, and closes a socket. - -=back - -=head2 Net::MySQL::RecordIterator API - -Net::MySQL::RecordIterator object is generated by the query() method of Net::MySQL object. Thus it has no public constructor method. - -=over 4 - -=item each() - -each() method takes out only one line from a result, and returns it as an ARRAY reference. C is returned when all the lines has been taken out. - - while (my $record = $a_record_iterator->each) { - printf "Column 1: %s Column 2: %s Collumn 3: %s\n", - $record->[0], $record->[1], $record->[2]; - } - -=back - -=head1 SUPPORT OPERATING SYSTEM - -This module has been tested on these OSes. - -=over 4 - -=item * MacOS 9.x - -with MacPerl5.6.1r. - -=item * MacOS X - -with perl5.6.0 build for darwin. - -=item * Windows2000 - -with ActivePerl5.6.1 build631. - -=item * FreeBSD 3.4 and 4.x - -with perl5.6.1 build for i386-freebsd. - -with perl5.005_03 build for i386-freebsd. - -=item * Linux - -with perl 5.005_03 built for ppc-linux. - -with perl 5.6.0 bult for i386-linux. - -=item * Solaris 2.6 (SPARC) - -with perl 5.6.1 built for sun4-solaris. - -with perl 5.004_04 built for sun4-solaris. - -Can use on Solaris2.6 with perl5.004_04, although I is failure. - -=back - -This list is the environment which I can use by the test usually. Net::MySQL will operate also in much environment which is not in a list. - -I believe this module can work with whatever perls which has B. I'll be glad if you give me a report of successful installation of this module on I OSes. - -=head1 SEE ALSO - -L, L - -=head1 AUTHOR - -Hiroyuki OYAMA Eoyama@module.jpE - -=head1 COPYRIGHT AND LICENCE - -Copyright (C) 2002 Hiroyuki OYAMA. Japan. All rights reserved. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/extras/Net/SSH.pm b/extras/Net/SSH.pm deleted file mode 100644 index 41f87f1f..00000000 --- a/extras/Net/SSH.pm +++ /dev/null @@ -1,255 +0,0 @@ -package Net::SSH; - -use strict; -use vars qw($VERSION @ISA @EXPORT_OK $ssh $equalspace $DEBUG @ssh_options); -use Exporter; -use IO::File; -use IPC::Open2; -use IPC::Open3; - -@ISA = qw(Exporter); -@EXPORT_OK = qw( ssh issh ssh_cmd sshopen2 sshopen3 ); -$VERSION = '0.07'; - -$DEBUG = 0; - -$ssh = "ssh"; - -=head1 NAME - -Net::SSH - Perl extension for secure shell - -=head1 SYNOPSIS - - use Net::SSH qw(ssh issh sshopen2 sshopen3); - - ssh('user@hostname', $command); - - issh('user@hostname', $command); - - ssh_cmd('user@hostname', $command); - ssh_cmd( { - user => 'user', - host => 'host.name', - command => 'command', - args => [ '-arg1', '-arg2' ], - stdin_string => "string\n", - } ); - - sshopen2('user@hostname', $reader, $writer, $command); - - sshopen3('user@hostname', $writer, $reader, $error, $command); - -=head1 DESCRIPTION - -Simple wrappers around ssh commands. - -For an all-perl implementation that does not require the system B command, -see L instead. - -=head1 SUBROUTINES - -=over 4 - -=item ssh [USER@]HOST, COMMAND [, ARGS ... ] - -Calls ssh in batch mode. - -=cut - -sub ssh { - my($host, @command) = @_; - @ssh_options = &_ssh_options unless @ssh_options; - my @cmd = ($ssh, @ssh_options, $host, @command); - warn "[Net::SSH::ssh] executing ". join(' ', @cmd). "\n" - if $DEBUG; - system(@cmd); -} - -=item issh [USER@]HOST, COMMAND [, ARGS ... ] - -Prints the ssh command to be executed, waits for the user to confirm, and -(optionally) executes the command. - -=cut - -sub issh { - my($host, @command) = @_; - my @cmd = ($ssh, $host, @command); - print join(' ', @cmd), "\n"; - if ( &_yesno ) { - system(@cmd); - } -} - -=item ssh_cmd [USER@]HOST, COMMAND [, ARGS ... ] - -=item ssh_cmd OPTIONS_HASHREF - -Calls ssh in batch mode. Throws a fatal error if data occurs on the command's -STDERR. Returns any data from the command's STDOUT. - -If using the hashref-style of passing arguments, possible keys are: - - user (optional) - host (requried) - command (required) - args (optional, arrayref) - stdin_string (optional) - written to the command's STDIN - -=cut - -sub ssh_cmd { - my($host, $stdin_string, @command); - if ( ref($_[0]) ) { - my $opt = shift; - $host = $opt->{host}; - $host = $opt->{user}. '@'. $host if exists $opt->{user}; - @command = ( $opt->{command} ); - push @command, @{ $opt->{args} } if exists $opt->{args}; - $stdin_string = $opt->{stdin_string}; - } else { - ($host, @command) = @_; - undef $stdin_string; - } - - my $reader = IO::File->new(); - my $writer = IO::File->new(); - my $error = IO::File->new(); - - sshopen3( $host, $writer, $reader, $error, @command ) or die $!; - - print $writer $stdin_string if defined $stdin_string; - close $writer; - - local $/ = undef; - my $output_stream = <$reader>; - my $error_stream = <$error>; - - if ( length $error_stream ) { - die "[Net:SSH::ssh_cmd] STDERR $error_stream"; - } - - return $output_stream; - -} - -=item sshopen2 [USER@]HOST, READER, WRITER, COMMAND [, ARGS ... ] - -Connects the supplied filehandles to the ssh process (in batch mode). - -=cut - -sub sshopen2 { - my($host, $reader, $writer, @command) = @_; - @ssh_options = &_ssh_options unless @ssh_options; - open2($reader, $writer, $ssh, @ssh_options, $host, @command); -} - -=item sshopen3 HOST, WRITER, READER, ERROR, COMMAND [, ARGS ... ] - -Connects the supplied filehandles to the ssh process (in batch mode). - -=cut - -sub sshopen3 { - my($host, $writer, $reader, $error, @command) = @_; - @ssh_options = &_ssh_options unless @ssh_options; - open3($writer, $reader, $error, $ssh, @ssh_options, $host, @command); -} - -sub _yesno { - print "Proceed [y/N]:"; - my $x = scalar(); - $x =~ /^y/i; -} - -sub _ssh_options { - my $reader = IO::File->new(); - my $writer = IO::File->new(); - my $error = IO::File->new(); - open3($writer, $reader, $error, $ssh, '-V'); - my $ssh_version = <$error>; - chomp($ssh_version); - if ( $ssh_version =~ /.*OpenSSH[-|_](\w+)\./ && $1 == 1 ) { - $equalspace = " "; - } else { - $equalspace = "="; - } - my @options = ( '-o', 'BatchMode'.$equalspace.'yes' ); - if ( $ssh_version =~ /.*OpenSSH[-|_](\w+)\./ && $1 > 1 ) { - unshift @options, '-T'; - } - @options; -} - -=back - -=head1 EXAMPLE - - use Net::SSH qw(sshopen2); - use strict; - - my $user = "username"; - my $host = "hostname"; - my $cmd = "command"; - - sshopen2("$user\@$host", *READER, *WRITER, "$cmd") || die "ssh: $!"; - - while () { - chomp(); - print "$_\n"; - } - - close(READER); - close(WRITER); - -=head1 FREQUENTLY ASKED QUESTIONS - -Q: How do you supply a password to connect with ssh within a perl script -using the Net::SSH module? - -A: You don't. Use RSA or DSA keys. See the ssh-keygen(1) manpage. - -Q: My script is "leaking" ssh processes. - -A: See L, L, -L and L. - -=head1 AUTHORS - -Ivan Kohler - -John Harrison contributed an example for the documentation. - -Martin Langhoff contributed the ssh_cmd command, and -Jeff Finucane updated it and took care of the 0.04 release. - -Anthony Awtrey contributed a fix for those still using -OpenSSH v1. - -=head1 COPYRIGHT - -Copyright (c) 2002 Ivan Kohler. -Copyright (c) 2002 Freeside Internet Services, LLC -All rights reserved. -This program is free software; you can redistribute it and/or modify it under -the same terms as Perl itself. - -=head1 BUGS - -Not OO. - -Look at IPC::Session (also fsh) - -=head1 SEE ALSO - -For an all-perl implementation that does not require the system B command, -see L instead. - -ssh-keygen(1), ssh(1), L, L, L - -=cut - -1; - diff --git a/extras/Time/HiRes.pm b/extras/Time/HiRes.1.55.pm similarity index 100% rename from extras/Time/HiRes.pm rename to extras/Time/HiRes.1.55.pm