view release on metacpan or  search on metacpan

lib/Mobile/Wurfl.pm  view on Meta::CPAN

    $ts ||= 0;
    print STDERR "last update: $ts\n";
    return $ts;
}

sub rebuild_tables
{
    my $self = shift;

    my $local = ($self->get_local_stats())[1];
    my $last_update = $self->last_update();
    if ( $local <= $last_update )
    {
        print STDERR "$self->{wurfl_file} has not changed since the last database update\n";
        return 0;
    }
    print STDERR "$self->{wurfl_file} is newer than the last database update\n";
    print STDERR "flush dB tables ...\n";
    $self->{dbh}->begin_work;
    $self->{dbh}->do( "DELETE FROM $self->{device_table_name}" );
    $self->{dbh}->do( "DELETE FROM $self->{capability_table_name}" );
    my ( $device_id, $group_id );
    print STDERR "create XML parser ...\n";
    my $xp = new XML::Parser(
        Style => "Object",
        Handlers => {
            Start => sub { 
                my ( $expat, $element, %attrs ) = @_;
                if ( $element eq 'group' )
                {
                    my %group = %attrs;
                    $group_id = $group{id};
                }
                if ( $element eq 'device' )
                {
                    my %device = %attrs;
                    my @keys = @{$tables{device}};
                    my @values = @device{@keys};
                    $device_id = $device{id};
                    $self->{device}{sth}->execute( @values );
                }
                if ( $element eq 'capability' )
                {
                    my %capability = %attrs;
                    my @keys = @{$tables{capability}};
                    $capability{deviceid} = $device_id;
                    $capability{groupid} = $group_id;
                    my @values = @capability{@keys};
                    $self->{capability}{sth}->execute( @values );
                }
            },
        }
    );
    print STDERR "parse XML ...\n";
    $xp->parsefile( $self->{wurfl_file} );
    print STDERR "commit dB ...\n";
    $self->{dbh}->commit;
    return 1;
}

sub update
{
    my $self = shift;
    print STDERR "get wurfl\n";
    my $got_wurfl = $self->get_wurfl();
    print STDERR "got wurfl: $got_wurfl\n";
    my $rebuilt ||= $self->rebuild_tables();
    print STDERR "rebuilt: $rebuilt\n";
    return $got_wurfl || $rebuilt;
}

sub get_local_stats
{
    my $self = shift;
    return ( 0, 0 ) unless -e $self->{wurfl_file};
    print STDERR "stat $self->{wurfl_file} ...\n";
    my @stat = ( stat $self->{wurfl_file} )[ 7,9 ];
    print STDERR "@stat\n";
    return @stat;
}

sub get_remote_stats
{
    my $self = shift;
    print STDERR "HEAD $self->{wurfl_url} ...\n";
    my $response = $self->{ua}->head( $self->{wurfl_url} );
    die $response->status_line unless $response->is_success;
    die "can't get content_length\n" unless $response->content_length;
    die "can't get last_modified\n" unless $response->last_modified;
    my @stat = ( $response->content_length, $response->last_modified );
    print STDERR "@stat\n";
    return @stat;
}

sub get_wurfl
{
    my $self = shift;
    my @local = $self->get_local_stats();
    my @remote = $self->get_remote_stats();
 
    if ( $local[1] == $remote[1] )
    {
        print STDERR "@local and @remote are the same\n";
        return 0;
    }
    print STDERR "@local and @remote are different\n";
    print STDERR "GET $self->{wurfl_url} -> $self->{wurfl_file} ...\n";

    #create a temp filename
    my $tempfile = "$self->{wurfl_home}/wurfl_$$";
    
    my $response = $self->{ua}->get( 
        $self->{wurfl_url},
        ':content_file' => $tempfile
    );
    die $response->status_line unless $response->is_success;
    if ($response->{_headers}->header('content-type') eq 'application/x-gzip') {
        gunzip($tempfile => $self->{wurfl_file}) || die "gunzip failed: $GunzipError\n";
        unlink($tempfile);
    } elsif ($response->{_headers}->header('content-type') eq 'application/zip') {
        unzip($tempfile => $self->{wurfl_file}) || die "unzip failed: $UnzipError\n";