HTTP::Proxy::GreaseMonkey::Script - A GreaseMonkey script.

HTTP-Proxy-GreaseMonkey documentation Contained in the HTTP-Proxy-GreaseMonkey distribution.

Index

Code Index:

NAME

Top

HTTP::Proxy::GreaseMonkey::Script - A GreaseMonkey script.

VERSION

Top

This document describes HTTP::Proxy::GreaseMonkey::Script version 0.05

SYNOPSIS

Top

    use HTTP::Proxy::GreaseMonkey::Script;

DESCRIPTION

Top

Represents a single GreaseMonkey user script.

INTERFACE

Top

new

match_uri

script

The Javascript source of this script.

support

The Javascript support code for this script

file

The filename of this script.

stat

Get the cached stat array for this script.

name

The descriptive name of this script

namespace

The namespace of this script.

description

The description of this script.

CONFIGURATION AND ENVIRONMENT

Top

HTTP::Proxy::GreaseMonkey::Script requires no configuration files or environment variables.

DEPENDENCIES

Top

None.

INCOMPATIBILITIES

Top

None reported.

BUGS AND LIMITATIONS

Top

No bugs have been reported.

Please report any bugs or feature requests to bug-http-proxy-greasemonkey@rt.cpan.org, or through the web interface at http://rt.cpan.org.

AUTHOR

Top

Andy Armstrong <andy@hexten.net>

LICENCE AND COPYRIGHT

Top

Copyright (c) 2007, Andy Armstrong <andy@hexten.net>.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic.

HTTP-Proxy-GreaseMonkey documentation Contained in the HTTP-Proxy-GreaseMonkey distribution. 
package HTTP::Proxy::GreaseMonkey::Script;

use strict;
use warnings;
use Carp;
use HTML::Tiny;


our $VERSION = '0.05';


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

    my @stat = stat $script_file
      or croak "Can't stat $script_file ($!)";

    open my $sh, '<', $script_file
      or croak "Can't read $script_file ($!)";
    my $script = do { local $/; <$sh> };
    close $sh;

    my %meta = ();
    if (
        $script =~ m{^ \s* // \s+ ==UserScript== \s+ 
                                            (.*?) ^ \s* // \s+==/UserScript== \s+ }xmsi
      ) {
        my $header = $1;
        while ( $header =~ m{ ^ \s* // \s+ \@(\w+)\s+(.+)$ }xmg ) {
            if ( $1 eq 'include' || $1 eq 'exclude' ) {
                push @{ $meta{$1} }, _gm_wildcard( $2 );
            }
            else {
                $meta{$1} = $2;
            }
        }
    }

    # Special case - if include is empty make it match anything
    $meta{include} = [qr{}] unless $meta{include};

    return bless {
        file   => $script_file,
        meta   => \%meta,
        stat   => \@stat,
        script => $script,
      },
      $class;
}


sub match_uri {
    my ( $self, $uri ) = @_;
    for my $exc ( @{ $self->{meta}->{exclude} || [] } ) {
        return if $uri =~ $exc;
    }
    for my $inc ( @{ $self->{meta}->{include} || [] } ) {
        return 1 if $uri =~ $inc;
    }
    return;
}


sub script { shift->{script} }


sub support {
    my $self = shift;
    my $h = $self->{_html} ||= HTML::Tiny->new;
    my @args
      = map { $h->json_encode( $_ ) } ( $self->namespace, $self->name );

    return join "\n", map {
            "function GM_$_() { return GM__proxyFunction("
          . join( ', ', $h->json_encode( $_ ), @args )
          . ", arguments) }"
    } qw( setValue getValue log );
}


sub file { shift->{file} }


sub stat { @{ shift->{stat} } }


sub name { shift->{meta}->{name} }


sub namespace { shift->{meta}->{namespace} }


sub description { shift->{meta}->{description} }

sub _gm_wildcard {
    my $wc      = shift;
    my $pattern = join '',
      map { $_ eq '*' ? '.*' : $_ eq '?' ? '.' : quotemeta( $_ ) }
      split /([*?])/, $wc;
    return qr{^$pattern$}i;
}

1;
__END__