Net::Appliance::Logical::BlueCoat::SGOS - Perl extension for interaction with Bluecoat

    use Net::Appliance::Logical::BlueCoat::SGOS;

    my $sg = Net::Appliance::Logical::BlueCoat::SGOS->new( 'proxy-hostname' );

    printf "%s (running version %s) has been up since %s\n",
            $sg->platform,
            $sg->version,
            $sg->started;

    $sg->delete_from_cache('http://cpan.perl.org/');

package Net::Appliance::Logical::BlueCoat::SGOS;
use base 'Net::Appliance::Logical';

use HTTP::Request::Common qw (GET POST);

use Carp;

sub new {
    my ( $class, $host, $opts ) = @_;

    my $self = bless {}, $class;

    croak "Must provide host"
      unless $host;

    $opts->{host} = $host;

    # Set some sensible defaults
    $opts->{user}      ||= 'admin';
    $opts->{port}      ||= '8081';
    $opts->{protocol}  ||= 'http';
    $opts->{community} ||= 'public';
    
    $opts->{timeout}   ||= 10;

    $self->{config} = $opts;

    return $self;
}

sub webget {
    my ( $self, $action, $opts ) = @_;

    my $admin_path =
      ref $action
      ? $action->{path}
      : $action;

    my $method = ref $action
        ? $action->{method}
        : 'GET';

    my $content = ref $action
        ? $action->{content}
        : '';

    my $delimiter = $action->{delim}
      if ref $action;

    my $url = sprintf '%s://%s:%s@%s:%s/%s', $self->{config}->{protocol},
      $self->{config}->{user}, $self->{config}->{password},
      $self->{config}->{host}, $self->{config}->{port}, $admin_path;

    my $arg =
      ref $opts
      ? $opts->{arg}
      : $opts;

    $arg and $url .= sprintf '/%s', $arg;

    my $req = $method eq 'GET'
        ? HTTP::Request->new( GET => $url )
        : POST $url,
          Content_Type=>'form-data',
          Content=>['file'=>[undef,'',Content=>$content] ];

    # Set our timout
    $self->ua->timeout($self->{config}->{timeout});
    
    # Make our request
    my $res = $self->ua->request( $req )
      or croak "Could not get URL $url";

    if ($delimiter) {
        my $h = {};
        map {
            my ( $k, $v ) = split /$delimiter/, $_, 2;
            $h->{ $self->trim($k) } = $self->trim($v);
        } split "\n", $res->content;

        return $h;
    }
    else {
        return $res->content;
    }
}

sub privcmd {
    my ($self, @cmds) = @_;
    
    use Data::Dumper;
    my @out;
    foreach (@cmds) {
        my $cmd = ref $_
            ? join "\n", @$_
            : $_;

        my $result = $self->webget({
            method => 'POST',
            path => 'Secure/Local/console/install_upload_action/archconf_post_setup.txt',
            content => $cmd
        });
        
        $result =~ /<pre>\r\n(.*)\r\n<\/pre>.*<p><B><I><FONT COLOR="#3333FF">There.*(\d+) error.*(\d+) warning/s;
        my $output = $1;
        my $errors = $2;
        my $warnings = $3;

        $result =~/^500 / and $errors++;

        push @out, {
            errors => $errors,
            warnings => $warnings,
            output => $output,
            raw => $result
        };
        
    }
    return $out[1]
        ? @out
        : $out[0];
}

sub cmd { return shift->privcmd(@_) };

__PACKAGE__->actions(
    {

        %{ Net::Appliance::Logical->actions },

        cpu                  => { snmpget => '1.3.6.1.4.1.3417.2.4.1.1.1.4.1' },
        version_string       => { snmpget => '1.3.6.1.2.1.65.1.1.1.1.2.1' },
        server_http_errors   => { snmpget => '1.3.6.1.3.25.17.3.2.2.2.0' },
        server_http_requests => { snmpget => '1.3.6.1.3.25.17.3.2.2.1.0' },
        server_http_traffic_in  => { snmpget => '1.3.6.1.3.25.17.3.2.2.3.0' },
        server_http_traffic_out => { snmpget => '1.3.6.1.3.25.17.3.2.2.4.0' },

        config         => { webget => 'archconf_expanded.txt' },
        config_brief   => { webget => 'archconf_brief.txt' },
        policy_local   => { webget => 'local_policy_source.txt' },
        policy_central => { webget => 'central_policy_source.txt' },
        policy_forward => { webget => 'forward_policy_source.txt' },
        policy_vpm     => { webget => 'config_policy_source.txt' },
        

        object_cache_info => { webget => 'HTTP/Info' },

        delete_from_cache => { webget => 'CE/Delete' },

        http_stats        => { webget => {
            path => 'HTTP/Statistics',
            delim => '\s+'
        } },

        smartfilter => { webget => {
            path  => 'ContentFilter/SmartFilter/Log',
            delim => ':'
        } },

        clear_cache     => { privcmd => 'clear_cache' },
        purge_dns_cache => { privcmd => 'purge_dns_cache' }
    }
);

sub uptime {
    return ( shift->action('uptime') / 100 );
}

sub started {
    return date( time - shift->uptime );
}

sub version {
    my $v = shift->version_string;

    $v =~ s/.*\/(.*)/$1/;
    return $v;
}

sub platform {
    my $v = shift->version_string;

    $v =~ s/(.*)\/.*/$1/;
    return $v;
}

sub smartfilter_version {
    return shift->smartfilter->{'Database version'};
}

sub smartfilter_download_date {
    return date shift->smartfilter->{'SmartFilter download at'};
}

sub categorize_url {
    my ($self, $url) = @_;
    
    my $return = $self->webget('ContentFilter/TestUrl/' . $url );
    return wantarray
        ? split '; /', $return
        : $return;
}

sub current_workers {
    return shift->http_stats->{HTTP_MAIN_0091};
}

sub object_cache_info {
    my ( $self, $url ) = @_;

    croak "$url is not a valid URL"
      unless $url =~ /$RE{URI}/;

    my $result = $self->action( 'object_cache_info', $url );
    
    $result =~ /CE_OBJECT_NOT_IN_CACHE/ and return 0;
    
    return $result;
}

sub delete_from_cache {
    my ( $self, $url ) = @_;

    croak "$url is not a valid URL"
      unless $url =~ /$RE{URI}/;

    $url =~ /(.*):\/\/(.*)/;

    my $result =
      $self->action( 'delete_from_cache', sprintf( "%s/%s", $1, $2 ) );

    $result =~ /successfully/ and return 1;
    return 0;
}

sub conf_net {
    my ($self, $url) = @_;
    
    return $self->cmd('conf net ' . $url);
}


# =pod
# 
# =item benchmark
# 
#   $sg->benchmark('http://www.yahoo.com/', 'http://www.google.com/');
# 
# Returns the amount of time in seconds taken to fetch the URLs passed.
# 
# =cut
# 
# sub benchmark {
#     my ($self, @urls) = @_;
# 
#     # ...
# }


1;

__END__