nano.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

#######################################################################
#
#  DBI::SQL::Nano - a very tiny SQL engine
#
#  Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
#
#  All rights reserved.
#
#  You may freely distribute and/or modify this  module under the terms
#  of either the GNU  General Public License (GPL) or the Artistic License,
#  as specified in the Perl README file.
#
#  See the pod at the bottom of this file for help information
#
#######################################################################

#######################
package DBI::SQL::Nano;
#######################
use strict;
use warnings;
require DBI; # for looks_like_number()
use vars qw( $VERSION $versions );
BEGIN {
    $VERSION = sprintf("1.%06d", q$Revision: 9744 $ =~ /(\d+)/o);

    $versions->{nano_version} = $VERSION;
    if ($ENV{DBI_SQL_NANO} || !eval { require "SQL/Statement.pm" }) {
        @DBI::SQL::Nano::Statement::ISA = qw(DBI::SQL::Nano::Statement_);
        @DBI::SQL::Nano::Table::ISA     = qw(DBI::SQL::Nano::Table_);
    }
    else {
        @DBI::SQL::Nano::Statement::ISA = qw( SQL::Statement );
        @DBI::SQL::Nano::Table::ISA     = qw( SQL::Eval::Table);
        $versions->{statement_version}  = $SQL::Statement::VERSION;
    }
}

###################################
package DBI::SQL::Nano::Statement_;
###################################

sub new {
    my($class,$sql) = @_;
    my $self = {};
    bless $self, $class;
    return $self->prepare($sql);
}

#####################################################################
# PREPARE
#####################################################################
sub prepare {
    my($self,$sql) = @_;
    $sql =~ s/\s+$//;
    for ($sql) {
        /^\s*CREATE\s+TABLE\s+(.*?)\s*\((.+)\)\s*$/is
            &&do{
                $self->{command}      = 'CREATE';
                $self->{table_name}   = $1;
                $self->{column_names} = parse_coldef_list($2) if $2;
                die "Can't find columns\n" unless $self->{column_names};
            };
        /^\s*DROP\s+TABLE\s+(IF\s+EXISTS\s+)?(.*?)\s*$/is
            &&do{
                $self->{command}      = 'DROP';
                $self->{table_name}   = $2;
                $self->{ignore_missing_table} = 1 if $1;
            };
        /^\s*SELECT\s+(.*?)\s+FROM\s+(\S+)((.*))?/is
            &&do{
                $self->{command}      = 'SELECT';
                $self->{column_names} = parse_comma_list($1) if $1;
                die "Can't find columns\n" unless $self->{column_names};
                $self->{table_name}   = $2;
                if ( my $clauses = $4) {
		    if ($clauses =~ /^(.*)\s+ORDER\s+BY\s+(.*)$/is) {
                        $clauses = $1;
                        $self->{order_clause} = $self->parse_order_clause($2);
		    }
                    $self->{where_clause}=$self->parse_where_clause($clauses)
                        if $clauses;
		}
            };
        /^\s*INSERT\s+INTO\s+(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is
            &&do{
                $self->{command}      = 'INSERT';
                $self->{table_name}   = $1;
                $self->{column_names} = parse_comma_list($2) if $2;
                $self->{values}       = $self->parse_values_list($4) if $4;
                die "Can't parse values\n" unless $self->{values};
            };
        /^\s*DELETE\s+FROM\s+(\S+)((.*))?/is
            &&do{
                $self->{command}      = 'DELETE';
                $self->{table_name}   = $1;
                $self->{where_clause} = $self->parse_where_clause($3) if $3;
            };
        /^\s*UPDATE\s+(\S+)\s+SET\s+(.+)(\s+WHERE\s+.+)/is
            &&do{
                $self->{command}      = 'UPDATE';
                $self->{table_name}   = $1;
                $self->parse_set_clause($2) if $2;
                $self->{where_clause} = $self->parse_where_clause($3) if $3;
            };
    }
    die "Couldn't parse\n"
	unless $self->{command} and $self->{table_name};
    return $self;
}
sub parse_order_clause {
    my($self,$str) = @_;
    my @clause = split /\s+/,$str;
    return { $clause[0] => 'ASC' } if @clause == 1;
    die "Bad ORDER BY clause '$str'\n" if @clause > 2;
    $clause[1] ||= '';
    return { $clause[0] => uc $clause[1] } if $clause[1] =~ /^ASC$/i
                                           or $clause[1] =~ /^DESC$/i;
    die "Bad ORDER BY clause '$clause[1]'\n";
}
sub parse_coldef_list  {                # check column definitions
    my @col_defs;
    for ( split',',shift ) {
        my $col = clean_parse_str($_);
        if ( $col =~ /^(\S+?)\s+.+/ ) { # doesn't check what it is
            $col = $1;                  # just checks if it exists
	}
        else {
 	    die "No column definition for '$_'\n";
	}
        push @col_defs,$col;
    }
    return \@col_defs;
}
sub parse_comma_list  {[map{clean_parse_str($_)} split(',',shift)]}
sub clean_parse_str { local $_ = shift; s/\(//;s/\)//;s/^\s+//; s/\s+$//; $_; }
sub parse_values_list {
    my($self,$str) = @_;
    [map{$self->parse_value(clean_parse_str($_))}split(',',$str)]
}
sub parse_set_clause {
    my $self = shift;
    my @cols = split /,/, shift;
    my $set_clause;
    for my $col(@cols) {
        my($col_name,$value)= $col =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/s;
        push @{$self->{column_names}}, $col_name;
        push @{$self->{values}}, $self->parse_value($value);
    }
    die "Can't parse set clause\n"
        unless $self->{column_names}
           and $self->{values};
}
sub parse_value {
    my($self,$str) = @_;
    return undef unless defined $str;
    $str =~ s/\s+$//;
    $str =~ s/^\s+//;
    if ($str =~ /^\?$/) {
        push @{$self->{params}},'?';
        return { value=>'?'  ,type=> 'placeholder' };
    }
    return { value=>undef,type=> 'NULL'   } if $str =~ /^NULL$/i;
    return { value=>$1   ,type=> 'string' } if $str =~ /^'(.+)'$/s;
    return { value=>$str ,type=> 'number' } if DBI::looks_like_number($str);
    return { value=>$str ,type=> 'column' };
}
sub parse_where_clause {
    my($self,$str) = @_;
    $str =~ s/\s+$//;
    if ($str =~ /^\s*WHERE\s+(.*)/i) {
        $str = $1;
    }
    else {
        die "Couldn't find WHERE clause in '$str'\n";
    }
    my($neg) = $str =~ s/^\s*(NOT)\s+//is;
    my $opexp = '=|<>|<=|>=|<|>|LIKE|CLIKE|IS';
    my($val1,$op,$val2) = $str =~ /^(.+?)\s*($opexp)\s*(.+)\s*$/iso;
    die "Couldn't parse WHERE expression '$str'\n"
       unless defined $val1 and defined $op and defined $val2;
    return {
        arg1 => $self->parse_value($val1),
        arg2 => $self->parse_value($val2),
        op   => $op,
        neg  => $neg,
    }
}

#####################################################################
# EXECUTE
#####################################################################
sub execute {
    my($self, $data, $params) = @_;
    my $num_placeholders = $self->params;
    my $num_params       = scalar @$params || 0;
    die "Number of params '$num_params' does not match "
      . "number of placeholders '$num_placeholders'\n"
      unless $num_placeholders == $num_params;
    if (scalar @$params) {
        for my $i(0..$#{$self->{values}}) {
            if ($self->{values}->[$i]->{type} eq 'placeholder') {
                $self->{values}->[$i]->{value} = shift @$params;
            }
        }
        if ($self->{where_clause}) {
            if ($self->{where_clause}->{arg1}->{type} eq 'placeholder') {
                $self->{where_clause}->{arg1}->{value} = shift @$params;
            }
            if ($self->{where_clause}->{arg2}->{type} eq 'placeholder') {
                $self->{where_clause}->{arg2}->{value} = shift @$params;
            }
        }
    }
    my $command = $self->{command};
    ( $self->{'NUM_OF_ROWS'},
      $self->{'NUM_OF_FIELDS'},
      $self->{'data'},
    ) = $self->$command($data, $params);
    $self->{NAME} ||= $self->{column_names};
    $self->{'NUM_OF_ROWS'} || '0E0';
}
sub DROP ($$$) {
    my($self, $data, $params) = @_;
    my $table = $self->open_tables($data, 0, 0);
    $table->drop($data);
    (-1, 0);
}
sub CREATE ($$$) {
    my($self, $data, $params) = @_;
    my $table = $self->open_tables($data, 1, 1);
    $table->push_names($data, $self->{column_names});
    (0, 0);
}
sub INSERT ($$$) {
    my($self, $data, $params) = @_;
    my $table = $self->open_tables($data, 0, 1);
    $self->verify_columns($table);
    $table->seek($data, 0, 2);
    my($array) = [];
    my($val, $col, $i);
    $self->{column_names}=$table->{col_names} unless $self->{column_names};
    my $cNum = scalar(@{$self->{column_names}}) if $self->{column_names};
    my $param_num = 0;
    if ($cNum) {
        for ($i = 0;  $i < $cNum;  $i++) {
            $col = $self->{column_names}->[$i];
            $array->[$self->column_nums($table,$col)] = $self->row_values($i);
        }
    } else {
        die "Bad col names in INSERT";
    }
    $table->push_row($data, $array);
    (1, 0);
}
sub DELETE ($$$) {
    my($self, $data, $params) = @_;
    my $table = $self->open_tables($data, 0, 1);
    $self->verify_columns($table);
    my($affected) = 0;
    my(@rows, $array);
    if ( $table->can('delete_one_row') ) {
        while (my $array = $table->fetch_row($data)) {
            if ($self->eval_where($table,$array)) {
                ++$affected;
                $array = $self->{fetched_value} if $self->{fetched_from_key};
                $table->delete_one_row($data,$array);
                return ($affected, 0) if $self->{fetched_from_key};
            }
        }
        return ($affected, 0);
    }
    while ($array = $table->fetch_row($data)) {
        if ($self->eval_where($table,$array)) {
            ++$affected;
        } else {
            push(@rows, $array);
        }
    }
    $table->seek($data, 0, 0);
    foreach $array (@rows) {
        $table->push_row($data, $array);
    }
    $table->truncate($data);
    return ($affected, 0);
}
sub SELECT ($$$) {
    my($self, $data, $params) = @_;
    my $table = $self->open_tables($data, 0, 0);
    $self->verify_columns($table);
    my $tname = $self->{table_name};
    my($affected) = 0;
    my(@rows, $array, $val, $col, $i);
    while ($array = $table->fetch_row($data)) {
        if ($self->eval_where($table,$array)) {
            $array = $self->{fetched_value} if $self->{fetched_from_key};
            my $col_nums = $self->column_nums($table);
            my %cols   = reverse %{ $col_nums };
            my $rowhash;
            for (sort keys %cols) {
                $rowhash->{$cols{$_}} = $array->[$_];
            }
            my @newarray;
            for ($i = 0;  $i < @{$self->{column_names}};  $i++) {
               $col = $self->{column_names}->[$i];
               push @newarray,$rowhash->{$col};
            }
            push(@rows, \@newarray);
            return (scalar(@rows),scalar @{$self->{column_names}},\@rows)
 	        if $self->{fetched_from_key};
        }
    }
    if ( $self->{order_clause} ) {
        my( $sort_col, $desc ) = each %{$self->{order_clause}};
        undef $desc unless $desc eq 'DESC';
        my @sortCols = ( $self->column_nums($table,$sort_col,1) );
        my($c, $d, $colNum);
        my $sortFunc = sub {
            my $result;
            $i = 0;
            do {
                $colNum = $sortCols[$i++];
                # $desc = $sortCols[$i++];
                $c = $a->[$colNum];
                $d = $b->[$colNum];
                if (!defined($c)) {
                    $result = defined $d ? -1 : 0;
                } elsif (!defined($d)) {
                    $result = 1;
	        } elsif ( DBI::looks_like_number($c) && DBI::looks_like_number($d) ) {
                    $result = ($c <=> $d);
                } else {
  		    if ($self->{"case_fold"}) {
                        $result = lc $c cmp lc $d || $c cmp $d;
		    }
                    else {
                        $result = $c cmp $d;
		    }
                }
                if ($desc) {
                    $result = -$result;
                }
            } while (!$result  &&  $i < @sortCols);
            $result;
        };
        @rows = (sort $sortFunc @rows);
    }